Board logo

標題: 請問資料比對且運算到工作表三 [打印本頁]
作者: enhrulee    時間: 2011-7-23 11:21     標題: 請問資料比對且運算到工作表三

各位前輩好
爬文找了很多文章雖然有找到類似的問題
但是檔案也不能下載只好重複問一下類似的問題
工作表一
今天的交易品項與數量
工作表二是
今天商品的報價
工作表三是
營業額的記錄區

商品有很多種但是每天交易的商品種類不固定數量也不固定
例如商品總共有99種
第一天交易的商品是1,3,5,8,16,72,44,56
第二天交易的商品是9,61,77,51,34,26,89,54,59,68,
每天商品的報價也不同

希望在工作表三記錄下
所有商品每日的營業額
工作表欄位分別為
A1:產品名稱
B1:累計20日營業額
C1~V1:日期
每次新增一日的營業額都在C欄,而原紀錄在C欄~V欄則往右移
原本V欄最早的記錄則刪除
也就是說工作表三永遠只保留二十日的營業額記錄
[attach]7121[/attach]
作者: GBKEE    時間: 2011-7-23 14:42

回復 1# enhrulee
試試看
  1. Sub Ex()
  2.     Dim D As Object, DX As Object, Rng As Range
  3.     Set D = CreateObject("SCRIPTING.DICTIONARY")   '今日報價 物件
  4.     Set DX = CreateObject("SCRIPTING.DICTIONARY")  '今日報價*今日單量 物件
  5.     Set Rng = Sheets("今日報價").Range("A2")
  6.     Do While Rng <> ""                             '取得 產品今日報價物件的 迴圈
  7.         D(Rng.Value) = Rng.Offset(, 1).Value
  8.         Set Rng = Rng.Offset(1)                    '設定為往下一列
  9.     Loop
  10.     Set Rng = Sheets("今天交易").Range("A2")
  11.     Do While Rng <> ""                          '取得 今日產品報價  * 今天單量 =金額 的迴圈
  12.         If DX.EXISTS(Rng.Value) Then            '今日產品單量已出現
  13.             DX(Rng.Value) = DX(Rng.Value) + D(Rng.Value) * Rng.Offset(, 1).Value
  14.         Else
  15.             DX(Rng.Value) = D(Rng.Value) * Rng.Offset(, 1).Value
  16.         End If
  17.        'DX.EXSITS(Rng.Value)        今天交易的產品名稱存在
  18.        'D(Rng.Value)                產品 今日報價
  19.        'Rng.Offset(, 1).Value       產品 今日單量
  20.        'DX(Rng.Value)               今天單量*今日報價
  21.         Set Rng = Rng.Offset(1)
  22.     Loop
  23.     With Sheets("交易紀錄")
  24.         If .Range("C1") <> Date Then    '不是當日
  25.             .Columns("C:C").Insert
  26.             .Columns("V:V") = ""
  27.             .Range("C1") = Date
  28.         End If
  29.         Set Rng = .Range("A2")
  30.         Do While Rng <> ""      '取得 今天有交易紀錄 產品  的迴圈
  31.             If DX.EXISTS(Rng.Value) Then Rng.Offset(, 2) = DX(Rng.Value)
  32.             '產品今日有交易  C欄輸入總金額
  33.             Rng.Offset(, 1) = "=SUM(" & Rng.Offset(, 2).Resize(1, 20).Address & ")" '
  34.             'B欄輸入公式
  35.             Set Rng = Rng.Offset(1)
  36.         Loop
  37.     End With
  38. End Sub
複製代碼
作者: enhrulee    時間: 2011-7-23 17:12

回復  enhrulee
試試看
GBKEE 發表於 2011-7-23 14:42



    感謝版主的熱心幫忙
我有稍微修改了一小部分
If .Range("C1") <> Date Then    '不是當日
            .Columns("C:C").Insert
            .Columns("W:W") = ""
            .Range("C1") = Date
        End If

應該是執行順序的原因
原本版主寫的程式會刪除掉原第二天(U欄)的資料
小小的修正就OK了~
超級感謝的還有中文註解
真的很貼心
:$
作者: GBKEE    時間: 2011-7-24 07:02

回復 3# enhrulee
程式會刪除掉原第二天(U欄)的資料
.Columns("V:V") = ""     
是刪除掉V欄,你跟我一樣粗心.
作者: Andy2483    時間: 2023-5-24 11:03

本帖最後由 Andy2483 於 2023-5-24 11:04 編輯

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教

今日交易表 & 今日報價表:
[attach]36419[/attach]  [attach]36420[/attach]

結果表執行前:
[attach]36421[/attach]

執行結果:
[attach]36422[/attach]


Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Y, i&
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Brr = Range([今日報價!B2], [今日報價!A65536].End(3))
'↑令Brr變數是 二維陣列,以今日報價表 儲存格值帶入陣列裡
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "/報") = Brr(i, 2): Next
'↑設順迴圈,令產品名稱 連接 "/報"當key,item是B欄的報價
Brr = Range([今天交易!B2], [今天交易!A65536].End(3))
'↑令Brr變數是 二維陣列,以今天交易表儲存格值帶入陣列裡
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "/易") = Y(Brr(i, 1) & "/易") + Brr(i, 2): Next
'↑設順迴圈,令產品名稱 連接 "/易"當key,item是B欄的單量做累加
Arr = Range([交易紀錄!A1], [交易紀錄!A65536].End(3))
'↑令Arr變數是 二維陣列,以交易紀錄表 A欄儲存格值帶入陣列裡
If [交易紀錄!C1] = Date Then
'↑如果[交易紀錄!C1]儲存格值是 今天日期,代表今日已經執行過
   Crr = Range([交易紀錄!V1], [交易紀錄!C65536].End(3))
   '↑令Crr變數是 二維陣列,以交易紀錄表C~V欄儲存格值帶入陣列
   Else '否則
      Crr = Range([交易紀錄!V1], [交易紀錄!B65536].End(3))
      '↑令Crr變數是 二維陣列,以交易紀錄表B~V欄儲存格值帶入陣列
End If
For i = 2 To UBound(Crr)
'↑設順迴圈
   Crr(i, 1) = Y(Arr(i, 1) & "/報") * Y(Arr(i, 1) & "/易")
   '↑令Crr陣列的第1欄帶入查Y字典計算出來的每個產品交易金額
Next
Crr(1, 1) = Date
'↑令Crr陣列1索引號列1索引號欄陣列值是 今天日期
[交易紀錄!C1].Resize(UBound(Crr), 20) = Crr
'↑令Crr陣列值從[交易紀錄!C1]開始寫入儲存格裡
Set Y = Nothing: Erase Arr,Brr, Crr
'↑令釋放變數
End Sub



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)