Option Explicit
Sub 字典與陣列練習()
Dim Brr, Crr, c&, i&, x&, xR, Y, U, ERR&
Set Y = CreateObject("Scripting.Dictionary")
Brr = Range([操作表!B2], [操作表!B65536].End(3))
For i = 1 To UBound(Brr)
If Trim(Brr(i, 1)) = "" Then ERR = 1: GoTo 111
Crr = Split(Trim(Brr(i, 1)), " ")
U = Trim(Crr(0)) & Y(Trim(Crr(0)) & i)
Crr = Split(Replace((Brr(i, 1)), " ", ""), U)
If UBound(Crr) <= 1 Then ERR = 1: GoTo 111
For x = UBound(Crr) To 2 Step -1
If IsNumeric(Trim(Crr(x))) = False Then
ERR = 1: GoTo 111
End If
Y(U & i) = Y(U & i) + Val(Trim(Crr(x)))
Next
Next
111
If ERR = 1 Then
Cells(i + 1, 2).Activate
ActiveCell.Interior.ColorIndex = 38
MsgBox "請檢查資料!"
Exit Sub
End If
[C2].Resize(Y.Count, 1) = Application.Transpose(Y.ITEMS)
End Sub作者: hcm19522 時間: 2022-11-2 14:18