麻辣家族討論版版 - Powered by Discuz! Board

標題: vba 累加問題 [打印本頁]

作者: color790 時間: 2011-10-24 21:21 標題: vba 累加問題

請教各位高手, 這個該怎麼寫, 想不出來:( [attach]8327[/attach]
如附件, 想把同一秒的數量累加, 及最後一個價格和與第一個價格相減
時間          價格                               數量
8450100 b14-b2=-2                   sum(c2:c14)=38

時間             價格    量
8450100 7232 4
8450100 7229 2
8450100 7229 2
8450100 7228 4
8450100 7228 2
8450100 7228 2
8450100 7227 2
8450100 7227 2
8450100 7226 2
8450100 7226 2
8450100 7228 6
8450100 7231 4
8450100 7230 4

作者: Hsieh 時間: 2011-10-24 22:43

本帖最後由 Hsieh 於 2011-10-24 23:10 編輯

Sub ex()
Set d = CreateObject("Scripting.Dictionary") '紀錄B、C欄的值
Set d1 = CreateObject("Scripting.Dictionary") '記錄每秒第一個出現的的價格
For Each a In Range([A2], [A2].End(xlDown)) '在A欄位做迴圈
If d.exists(a.Value) = False Then '如果A的值沒被記錄在d字典內
d(a.Value) = Array(a.Offset(, 1).Value, a.Offset(, 2).Value) '將B、C欄的值記錄到d字典內
d1(a.Value) = a.Offset(, 1).Value '記住每秒第一個出現的的價格
Else
ar = d(a.Value) '取出d字典對應的內容
ar(0) = a.Offset(, 1).Value - d1(a.Value) '把B欄的值減掉對應A欄的值(第一次出現的值)
ar(1) = ar(1) + a.Offset(, 2).Value 'C欄位加上前加總的值
d(a.Value) = ar '把陣列回存到字典中
End If
Next
[F2].Resize(d.Count, 1) = Application.Transpose(d.keys) '把每秒的字串(字典索引值)寫入
[G2].Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items)) '把字典內容寫入
End Sub

複製代碼

回復 1# color790

作者: color790 時間: 2011-10-24 22:59

本帖最後由 color790 於 2011-10-24 23:03 編輯

感謝超級版主的協助, 感恩再感恩.....
中間價格的計算好像有點錯誤, 如時間在8450300, 8451500, 8452700....
但小弟只會比較基本的語法, 這個比較不懂, 可否麻煩版主幫我註解一下, 讓我多學一點, 謝謝~

作者: Hsieh 時間: 2011-10-24 23:36

回復 3# color790

你A欄的資料沒有完全群組到
重新排序過你就會發現

作者: color790 時間: 2011-10-24 23:53

回復 color790

你A欄的資料沒有完全群組到
重新排序過你就會發現
Hsieh 發表於 2011-10-24 23:36

版主,我不太懂群組到的意思? 重新排序後, 結果好像是一樣......

作者: Hsieh 時間: 2011-10-25 00:08

回復 5# color790

原本A26:A44是8450300共19筆資料
排序後變成A30:A50是8450300共21筆資料

作者: color790 時間: 2011-10-25 14:46

回復 color790

原本A26:A44是8450300共19筆資料
排序後變成A30:A50是8450300共21筆資料
Hsieh 發表於 2011-10-25 00:08

嗯........我懂了, 原來是資料我有整理, 所以有這個問題
另外再問一下, 例如8451500 這個時間, 由於它只有一筆資料, 所以它只會顯示相對的價格, 這個有解嗎?

作者: Hsieh 時間: 2011-10-25 15:11

回復 7# color790

只有一筆資料, 所以它只會顯示相對的價格, 這個有解嗎?

要解甚麼?

作者: color790 時間: 2011-10-25 15:37

就是讓它自己減自己或是直接顯示為0, 謝謝版主的回答

作者: Hsieh 時間: 2011-10-25 16:11

回復 9# color790

Sub ex()
Set d = CreateObject("Scripting.Dictionary") '紀錄B、C欄的值
Set d1 = CreateObject("Scripting.Dictionary") '記錄每秒第一個出現的的價格
For Each a In Range([A2], [A2].End(xlDown)) '在A欄位做迴圈
If d.exists(a.Value) = False Then '如果A的值沒被記錄在d字典內
d1(a.Value) = a.Offset(, 1).Value '記住每秒第一個出現的的價格
d(a.Value) = Array(d1(a.Value) - a.Offset(, 1).Value, a.Offset(, 2).Value) '將B、C欄的值記錄到d字典內
Else
ar = d(a.Value) '取出d字典對應的內容
ar(0) = a.Offset(, 1).Value - d1(a.Value) '把B欄的值減掉對應A欄的值(第一次出現的值)
ar(1) = ar(1) + a.Offset(, 2).Value 'C欄位加上前加總的值
d(a.Value) = ar '把陣列回存到字典中
End If
Next
[F2].Resize(d.Count, 1) = Application.Transpose(d.keys) '把每秒的字串(字典索引值)寫入
[G2].Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items)) '把字典內容寫入
End Sub

複製代碼

作者: color790 時間: 2011-10-25 20:42

感謝版主的幫忙, 自己要好好用功消化一下....

作者: Andy2483 時間: 2023-3-31 08:57

回復 1# color790

謝謝論壇,謝謝前輩發表此主題與範例,謝謝各位前輩
後學藉此帖練習陣列與字典,學習的方案如下,請各位前輩指教

執行前:
[attach]36068[/attach]

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

Option Explicit
Sub TEST()
Dim Brr, Y, N&, i&, j&, T&, T2&, T3&
Dim xR As Range, Ra As Range, Sh As Sheets
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([C1], Cells(Rows.Count, "A").End(xlUp))
Brr = xR: N = 1
For i = 2 To UBound(Brr)
T = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3)
If Y(T) = "" Then
   N = N + 1: Y(T) = N: Brr(N, 1) = T: Brr(N, 3) = T3
   Y(T & "|sd") = T2: Brr(N, 2) = T2 - Y(T & "|sd")
   Else
      Brr(Y(T), 2) = T2 - Y(T & "|sd")
      Brr(Y(T), 3) = Brr(Y(T), 3) + T3
End If
Next
With xR.Offset(, 15)
.EntireColumn.ClearContents: .Resize(N, 3) = Brr
End With
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub

作者: Andy2483 時間: 2023-3-31 10:00

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,添加最低價/最高價/均價,請各位前輩指教

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

Option Explicit
Sub TEST_1()
Dim Brr, Y, N&, S&, i&, j&, T&, T2&, T3&
Dim xR As Range, Ra As Range, Sh As Sheets
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([F1], Cells(Rows.Count, "A").End(xlUp))
Brr = xR: N = 1
For i = 2 To UBound(Brr)
T = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3)
If Y(T) = "" Then
   N = N + 1: Y(T) = N: S = N: Brr(N, 1) = T: Brr(N, 3) = T3
   Y(T & "|sd") = T2: Y(T & "|mi") = T2: Y(T & "|ma") = T2
   Else
      N = Y(T): Brr(N, 3) = Brr(N, 3) + T3
      Y(T & "|mi") = IIf(T2 > Y(T & "|mi"), Y(T & "|mi"), T2)
      Y(T & "|ma") = IIf(T2 < Y(T & "|ma"), Y(T & "|ma"), T2)
End If
Y(T & "|q") = Y(T & "|q") + T3: Y(T & "|tot") = Y(T & "|tot") + (T2 * T3)
Brr(N, 2) = T2 - Y(T & "|sd")
Brr(N, 4) = Y(T & "|mi"): Brr(N, 5) = Y(T & "|ma")
Brr(N, 6) = Y(T & "|tot") / Y(T & "|q")
Next
With xR.Offset(, 15)
.EntireColumn.ClearContents: .Resize(S, 6) = Brr
.Item(1, 4).Resize(1, 3) = [{"最低價","最高價","均價"}]
End With
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub

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