請問資料比對且運算到工作表三
各位前輩好爬文找了很多文章雖然有找到類似的問題
但是檔案也不能下載只好重複問一下類似的問題
工作表一
今天的交易品項與數量
工作表二是
今天商品的報價
工作表三是
營業額的記錄區
商品有很多種但是每天交易的商品種類不固定數量也不固定
例如商品總共有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] [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=23480&ptid=4173]1#[/url] [i]enhrulee[/i] [/b]
試試看[code]Sub Ex()
Dim D As Object, DX As Object, Rng As Range
Set D = CreateObject("SCRIPTING.DICTIONARY") '今日報價 物件
Set DX = CreateObject("SCRIPTING.DICTIONARY") '今日報價*今日單量 物件
Set Rng = Sheets("今日報價").Range("A2")
Do While Rng <> "" '取得 產品今日報價物件的 迴圈
D(Rng.Value) = Rng.Offset(, 1).Value
Set Rng = Rng.Offset(1) '設定為往下一列
Loop
Set Rng = Sheets("今天交易").Range("A2")
Do While Rng <> "" '取得 今日產品報價 * 今天單量 =金額 的迴圈
If DX.EXISTS(Rng.Value) Then '今日產品單量已出現
DX(Rng.Value) = DX(Rng.Value) + D(Rng.Value) * Rng.Offset(, 1).Value
Else
DX(Rng.Value) = D(Rng.Value) * Rng.Offset(, 1).Value
End If
'DX.EXSITS(Rng.Value) 今天交易的產品名稱存在
'D(Rng.Value) 產品 今日報價
'Rng.Offset(, 1).Value 產品 今日單量
'DX(Rng.Value) 今天單量*今日報價
Set Rng = Rng.Offset(1)
Loop
With Sheets("交易紀錄")
If .Range("C1") <> Date Then '不是當日
.Columns("C:C").Insert
.Columns("V:V") = ""
.Range("C1") = Date
End If
Set Rng = .Range("A2")
Do While Rng <> "" '取得 今天有交易紀錄 產品 的迴圈
If DX.EXISTS(Rng.Value) Then Rng.Offset(, 2) = DX(Rng.Value)
'產品今日有交易 C欄輸入總金額
Rng.Offset(, 1) = "=SUM(" & Rng.Offset(, 2).Resize(1, 20).Address & ")" '
'B欄輸入公式
Set Rng = Rng.Offset(1)
Loop
End With
End Sub
[/code] [quote]回復 enhrulee
試試看
[size=2][color=#999999]GBKEE 發表於 2011-7-23 14:42[/color] [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=23490&ptid=4173][img]http://forum.twbts.com/images/common/back.gif[/img][/url][/size][/quote]
感謝版主的熱心幫忙
我有稍微修改了一小部分
If .Range("C1") <> Date Then '不是當日
.Columns("C:C").Insert
.Columns("[b][color=Red]W:W[/color][/b]") = ""
.Range("C1") = Date
End If
應該是執行順序的原因
原本版主寫的程式會刪除掉原第二天(U欄)的資料
小小的修正就OK了~
超級感謝的還有中文註解
真的很貼心
:$ [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=23499&ptid=4173]3#[/url] [i]enhrulee[/i] [/b]
[color=red]程式會刪除掉原第二天([color=black][b]U[/b][/color]欄)的資料[/color]
.Columns("V:V") = ""
是刪除掉V欄,[b]你跟我一樣粗心.
[/b] [i=s] 本帖最後由 Andy2483 於 2023-5-24 11:04 編輯 [/i]
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案如下,請各位前輩指教
今日交易表 & 今日報價表:
[attach]36419[/attach] [attach]36420[/attach]
結果表執行前:
[attach]36421[/attach]
執行結果:
[attach]36422[/attach]
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Y, i&
[color=SeaGreen]'↑宣告變數[/color]
Set Y = CreateObject("Scripting.Dictionary")
[color=SeaGreen]'↑令Y變數是 字典[/color]
Brr = Range([今日報價!B2], [今日報價!A65536].End(3))
[color=SeaGreen]'↑令Brr變數是 二維陣列,以今日報價表 儲存格值帶入陣列裡[/color]
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "/報") = Brr(i, 2): Next
[color=SeaGreen]'↑設順迴圈,令產品名稱 連接 "/報"當key,item是B欄的報價[/color]
Brr = Range([今天交易!B2], [今天交易!A65536].End(3))
[color=SeaGreen]'↑令Brr變數是 二維陣列,以今天交易表儲存格值帶入陣列裡[/color]
For i = 1 To UBound(Brr): Y(Brr(i, 1) & "/易") = Y(Brr(i, 1) & "/易") + Brr(i, 2): Next
[color=SeaGreen]'↑設順迴圈,令產品名稱 連接 "/易"當key,item是B欄的單量做累加[/color]
Arr = Range([交易紀錄!A1], [交易紀錄!A65536].End(3))
[color=SeaGreen]'↑令Arr變數是 二維陣列,以交易紀錄表 A欄儲存格值帶入陣列裡[/color]
If [交易紀錄!C1] = Date Then
[color=SeaGreen]'↑如果[交易紀錄!C1]儲存格值是 今天日期,代表今日已經執行過[/color]
Crr = Range([交易紀錄!V1], [交易紀錄!C65536].End(3))
[color=SeaGreen] '↑令Crr變數是 二維陣列,以交易紀錄表C~V欄儲存格值帶入陣列[/color]
Else[color=SeaGreen] '否則[/color]
Crr = Range([交易紀錄!V1], [交易紀錄!B65536].End(3))
[color=SeaGreen] '↑令Crr變數是 二維陣列,以交易紀錄表B~V欄儲存格值帶入陣列[/color]
End If
For i = 2 To UBound(Crr)
[color=SeaGreen]'↑設順迴圈[/color]
Crr(i, 1) = Y(Arr(i, 1) & "/報") * Y(Arr(i, 1) & "/易")
[color=SeaGreen] '↑令Crr陣列的第1欄帶入查Y字典計算出來的每個產品交易金額[/color]
Next
Crr(1, 1) = Date
[color=SeaGreen]'↑令Crr陣列1索引號列1索引號欄陣列值是 今天日期[/color]
[交易紀錄!C1].Resize(UBound(Crr), 20) = Crr
[color=SeaGreen]'↑令Crr陣列值從[交易紀錄!C1]開始寫入儲存格裡[/color]
Set Y = Nothing: Erase Arr,Brr, Crr
[color=SeaGreen]'↑令釋放變數[/color]
End Sub
頁:
[1]