72 lines
2.0 KiB
VB.net
72 lines
2.0 KiB
VB.net
Attribute VB_Name = "工作表14"
|
|
Private Sub Worksheet_Activate()
|
|
Dim startTime As Double, totalRows As Long
|
|
Dim dict As Object
|
|
Dim itemAddup As New stdArray
|
|
Dim changeRange As Variant
|
|
Dim tmp As stdArray
|
|
Dim oArr As Variant, pArr As Variant, qArr As Variant
|
|
Dim i As Long, arrWords As Variant
|
|
Dim key As Variant, vIter As Variant
|
|
|
|
' 創建字典
|
|
Set dict = CreateObject("Scripting.Dictionary")
|
|
|
|
' 設置範圍
|
|
changeRange = Me.Range("ChangeTBL").Resize(100)
|
|
|
|
' 開始計時
|
|
startTime = Timer
|
|
|
|
' 填充字典
|
|
For i = 1 To UBound(changeRange)
|
|
If Not IsEmpty(changeRange(i, 1)) Then
|
|
Call FillDictionary(dict, changeRange(i, 1) & "_" & changeRange(i, 2), changeRange(i, 3))
|
|
End If
|
|
Next i
|
|
|
|
' 將字典中的項目添加到 itemAddup
|
|
Set itemAddup = stdArray.Create
|
|
For Each key In dict.keys
|
|
itemAddup.Push key & "_" & dict(key)
|
|
Next key
|
|
totalRows = dict.count
|
|
|
|
' 初始化輸出範圍的數組
|
|
Me.Range("O3").CurrentRegion.ClearContents
|
|
oArr = Me.Range("O3").Resize(totalRows)
|
|
pArr = Me.Range("P3").Resize(totalRows)
|
|
qArr = Me.Range("Q3").Resize(totalRows)
|
|
|
|
' 排序並將值填充到臨時數組
|
|
Set tmp = stdArray.Create
|
|
itemAddup.Sort().ForEach stdLambda.Create("$1.push($2)").Bind(tmp)
|
|
|
|
' 迭代臨時數組並將值填充到相應的欄位
|
|
i = 1
|
|
For Each vIter In tmp
|
|
arrWords = Split(vIter, "_")
|
|
oArr(i, 1) = arrWords(0)
|
|
pArr(i, 1) = arrWords(1)
|
|
qArr(i, 1) = arrWords(2)
|
|
i = i + 1
|
|
Next vIter
|
|
|
|
' 顯示執行時間
|
|
Me.Range("O1").value = Timer - startTime
|
|
|
|
' 將結果寫回工作表
|
|
Me.Range("O3").Resize(totalRows).value = oArr
|
|
Me.Range("P3").Resize(totalRows).value = pArr
|
|
Me.Range("Q3").Resize(totalRows).value = qArr
|
|
End Sub
|
|
|
|
Private Sub FillDictionary(ByRef dict As Object, item As Variant, itemValue As Variant)
|
|
If dict.Exists(item) Then
|
|
dict(item) = dict(item) + itemValue
|
|
Else
|
|
dict.Add item, itemValue
|
|
End If
|
|
End Sub
|
|
|