帖子: 10
主題: 4
精華: 0
積分: 20
點名: 0
作業系統: windows xp
軟體版本: vb2008
閱讀權限: 10
註冊時間: 2011-1-28
最後登錄: 2011-8-2

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 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欄最早的記錄則刪除
也就是說工作表三永遠只保留二十日的營業額記錄

交易紀錄.rar (24.91 KB)

樓主熱帖

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2011-7-23 14:42 | 只看該作者

回復 1# enhrulee
試試看

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

複製代碼

TOP

enhrulee

小學生 Rank: 1

帖子: 10
主題: 4
精華: 0
積分: 20
點名: 0
作業系統: windows xp
軟體版本: vb2008
閱讀權限: 10
註冊時間: 2011-1-28
最後登錄: 2011-8-2

3^#

發表於 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了~
超級感謝的還有中文註解
真的很貼心
:$

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2011-7-24 07:02 | 只看該作者

回復 3# enhrulee
程式會刪除掉原第二天(U欄)的資料
.Columns("V:V") = ""
是刪除掉V欄,你跟我一樣粗心.

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-11-29

5^#

發表於 2023-5-24 11:03 | 只看該作者

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

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

今日交易表 & 今日報價表:

結果表執行前:

執行結果:

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP