|
こんにちは
【23982】のマクロに記録したコードをちょっと修正したものです。
検索結果とは合計値でいいのですよね?
Sub test()
Dim s As String
s = "リンゴ"
Application.ScreenUpdating = False
With Worksheets("Sheet2")
.Range("A1").ClearOutline
.Range("A:F").ClearContents
Worksheets("Sheet1").Range("A1").CurrentRegion.Copy
.Range("A1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.Range("A1").Sort _
Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes
.Range("A1").Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4, 5, 6), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.Range("A1").ClearOutline
.Range("A1").CurrentRegion.Value = .Range("A1").CurrentRegion.Value
.Range("B:B").Find(s & " 計", , xlFormulas, xlWhole) _
.Offset(, 4).Copy .Range("H1")
End With
Application.ScreenUpdating = True
End Sub
|
|