| |
こんばんは。
確か、前に似たような質問があったような、
ichinoseさんが、回答していたように思います。
私では、
期待には応えられませんが、似たようなことならできます。
中分類をフィルターオプションで抽出し、オートフィルターで処理してます。
シート１がデータシート
シート２が結果シート
データシートのＦ列を作業列で使用しています。
Sub test()
Dim SH1 As Worksheet
Dim SH2 As Worksheet
Dim myR As Range
Dim myR2 As Range
Dim myVal As Variant
Set SH1 = Worksheets("sheet1")
Set SH2 = Worksheets("sheet2")
Set myR = SH1.Range("A1").CurrentRegion
Set myR2 = SH1.Range("D2:D" & myR.Rows.Count)
Application.ScreenUpdating = False
myR.Columns(2).AdvancedFilter xlFilterCopy, _
copytorange:=SH1.Range("F1"), unique:=True
myVal = SH1.Range("F2", SH1.Range("F65536").End(xlUp)).Value
For i = 1 To UBound(myVal, 1)
With myR
.AutoFilter field:=2, Criteria1:=myVal(i, 1)
.Offset(1, 0).Resize(myR.Rows.Count - 1, myR.Columns.Count).Copy _
SH2.Range("A65536").End(xlUp).Offset(3, 0)
With SH2.Range("C65536").End(xlUp).Offset(1, 0)
.Value = "合計"
.Font.Bold = True
.Offset(0, 1).Value = Application.Subtotal(9, myR2)
.Offset(0, 1).Font.Bold = True
End With
.AutoFilter
End With
Next
SH1.Range("F:F").ClearContents
Application.ScreenUpdating = True
|
|
ponpon
- 05/9/1(木) 20:39 -
