|
なんだかマルチポストをされると、回答する気が失せますね
Sub Try3() と Sub Try_Dic()のグループ別集計作業を
ドッキングさせたものを投稿して、ぼくの発言はこれにて
終了させていただきます。
Sub Try4c()
Dim WS1 As Worksheet
Dim ColA As Range, c As Range
Dim v, u, w, key
Dim ss As String, sss As String
Dim i As Long, ii As Long, j As Long, n As Long
Dim total As Double
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Set WS1 = Worksheets("Anoth") '------- 集計元データシート
Set ColA = WS1.Range("A2", WS1.Cells(Rows.Count, 1).End(xlUp))
WS1.Columns("C:D").Insert
With ColA.Columns(3)
.Formula = "=ROW()"
.Value = .Value
End With
ColA.Columns(4).FormulaR1C1 = "=LEN(RC[-3])"
With ColA.Resize(, 4)
.Sort Key1:=.Columns(4), Header:=xlNo
v = Application.Transpose(.Columns(1))
u = Application.Transpose(.Columns(2))
.Sort Key1:=.Columns(3), Header:=xlNo
End With
WS1.Columns("C:D").Delete
For i = 1 To UBound(v)
ss = v(i)
If dic.Exists(ss) Then
Do
ss = ss & " "
Loop While dic.Exists(ss)
v(i) = ss
End If
dic(ss) = u(i)
If Not IsNumeric(ss) Then
If InStr("01", Left$(ss, 1)) Then ss = Mid$(ss, 2)
End If
If Len(ss) > 10 Then ss = Left$(ss, 10)
Distribute sss, ss
Next
u = Split(Left$(sss, Len(sss) - 1), "|")
n = dic.Count + UBound(u) + 1
ReDim tbl(n, 1 To 3)
i = 0
tbl(i, 1) = "種別"
tbl(i, 2) = "コード"
tbl(i, 3) = "数量"
For Each key In u
w = Filter(v, key)
total = 0
ii = 0
For j = 0 To UBound(w)
If dic(w(j)) > 0 Then
i = i + 1: ii = ii + 1
tbl(i, 2) = RTrim$(w(j))
tbl(i, 3) = dic(w(j))
total = total + dic(w(j))
dic(w(j)) = 0
End If
Next
If ii Then
i = i + 1
tbl(i, 1) = key
tbl(i, 2) = "合計"
tbl(i, 3) = total
End If
Next
With Worksheets.Add(After:=WS1)
With .Range("A1").Resize(n + 1, 3)
.Value = tbl
.Columns(3).NumberFormat = "#,##0"
For Each c In .Columns(1).SpecialCells( _
xlConstants, xlTextValues Or xlNumbers)
c.Resize(, 3).Interior.ColorIndex = 34
Next
End With
.Columns("A:C").AutoFit
End With
End Sub
マルチポスト先のデータにも対応できるようにしてあります。
A列が邪魔でしたら、削除するコードを付け加えてください。
A B C
種別 コード 数量
636233030 21
1636233030 90 4
63623 合計 25
4561410021 10
4561410021 400,000
04561410021G0 15
04561410021G0 53
45614 合計 400,078
4166110010 38,000
04166110010D6 4,000
4166110010 合計 42,000
1175955026 100
1175955026 12
11759 合計 112
04517610060G0 11
4517610060 合計 11
|
|