| |
こんにちは
Sheet1からSheet2として
Sub test()
Dim v, vv
Dim i As Long
Dim j As Long
Dim cntR As Long
Dim mDic As Object
Dim s As String
Dim c As Long
With Worksheets("Sheet1")
v = .Range("A1").CurrentRegion.Value
cntR = UBound(v, 1)
End With
If cntR = 1 Then Exit Sub
Set mDic = CreateObject("Scripting.Dictionary")
For i = 2 To cntR
c = 0: s = ""
If mDic.Exists(v(i, 2)) Then
If Val(v(i, 3)) = 2 Then
If mDic(v(i, 2))(1) <> "2" Then s = "2"
c = v(i, 4)
ElseIf mDic(v(i, 2))(1) <> "2" Then
s = v(i, 3)
Else
s = "2"
End If
mDic(v(i, 2)) = Array(v(i, 2), s, _
mDic(v(i, 2))(2) + v(i, 4), mDic(v(i, 2))(3) + c)
Else
If Val(v(i, 3)) = 2 Then
s = "2"
c = v(i, 4)
Else
s = v(i, 3)
End If
mDic(v(i, 2)) = Array(v(i, 2), s, v(i, 4), c)
End If
Next
Erase v
With Worksheets("Sheet2").Range("A1").Resize(mDic.Count + 1, 4)
.ClearContents
.Rows(1).Value = Array("伝票ＮＯ", "区分", "金額", "区分２金額")
v = .Value
i = 2
For Each vv In mDic.keys
For j = 0 To 3
v(i, j + 1) = mDic(vv)(j)
Next
i = i + 1
Next
.Value = v
End With
Set mDic = Nothing: Erase v
End Sub
いまいちのような気がしますけど。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
