VBA 代碼：
Sub Example():
Dim i As Double
Dim Letter As String
Dim var1 As Long
Dim var2 As Long
Dim Row_For_Table As Integer
Row_For_Table = 1
For i = 1 To 12
If Cells(i 1, 1).Value <> Cells(i, 1).Value Then
'MsgBox ("different")
Letter = Cells(i, 1).Value
var2 = Cells(i, 3).Value
var1 = Cells(i, 2).Value
Range("F" & Row_For_Table).Value = Letter
Range("G" & Row_For_Table).Value = var2 - var1
Row_For_Table = Row_For_Table 1
Else
'MsgBox ("same")
End If
Next i
End Sub
我想創建 A、B 和 C 的匯總表，其值為 (14-1)、(12-5) 和 (4-1)。我想寫這個 VBA 作為一個更大專案的模板。
謝謝你。
uj5u.com熱心網友回復：
這使用字典來做你正在尋找的東西。它假設您的表格按 A 列排序。
Dim i As Long
Dim lr As Long
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1") 'Change as needed
lr = .Cells(.Rows.Count, 1).End(xlUp).Row 'Lastrow
For i = 1 To lr 1
If Not dict.exists(.Cells(i, 1).Value) Then 'Key doesn't exist
dict.Add .Cells(i, 1).Value, .Cells(i, 2).Value 'Add key and first value
If i > 1 Then 'Avoid out of range errors
dict(.Cells(i - 1, 1).Value) = .Cells(i - 1, 3).Value - dict(.Cells(i - 1, 1).Value) 'Subtract old value from new value
End If
End If
Next i
Dim key As Variant
i = 1
For Each key In dict
.Cells(i, 6).Value = key 'place values
.Cells(i, 7).Value = dict(key)
i = i 1
Next key
End With
uj5u.com熱心網友回復：
這也使用字典，應該適用于多列。
Option Explicit
Sub StuffDo()
Dim rng As Range
Dim arrData As Variant
Dim ky As Variant
Dim dicLetters As Object
Dim arrNumbers()
Dim cnt As Long
Dim idxCol As Long
Dim idxRow As Long
arrData = Sheets("Sheet1").Range("A1").CurrentRegion.Value
Set dicLetters = CreateObject("Scripting.Dictionary")
For idxRow = LBound(arrData, 1) To UBound(arrData, 1)
For idxCol = LBound(arrData, 2) 1 To UBound(arrData, 2)
ky = arrData(idxRow, 1)
If Not dicLetters.exists(ky) Then
arrNumbers = Array(arrData(idxRow, idxCol))
Else
arrNumbers = dicLetters(ky)
cnt = UBound(arrNumbers) 1
ReDim Preserve arrNumbers(cnt)
arrNumbers(cnt) = arrData(idxRow, idxCol)
End If
dicLetters(ky) = arrNumbers
Next idxCol
Next idxRow
Set rng = Range("A1").Offset(, Range("A1").CurrentRegion.Columns.Count 2)
For Each ky In dicLetters.keys
arrNumbers = dicLetters(ky)
rng.Value = ky
rng.Offset(, 1) = arrNumbers(UBound(arrNumbers))
rng.Offset(, 2) = arrNumbers(0)
Set rng = rng.Offset(1)
Next ky
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qita/391126.html