| |
こんにちは
>Sheet1に
>A列,B列,C列,D列,E列
>日付,コード,事業名,通数,単価
>10/5,001,バラ,3,95
>10/5,001,バラ,2,110
>10/5,002,ひまわり,5,95
>10/5,003,コスモス,6,110
>10/7,001,バラ,2,95
>10/7,001,バラ,5,110
>10/7,ひまわり,7,110
>10/7,コスモス,2,95
このデータを使ってマクロ自動記録を採ってせっせと修正すると、
Sub test()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sht As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sht = Worksheets.Add
sh2.UsedRange.ClearContents
Application.ScreenUpdating = False
With sht
sh1.Columns("B:E").Copy .Range("A1")
.Range("A1").CurrentRegion.Sort _
Key1:=.Range("A2"), Order1:=xlAscending, _
Key2:=.Range("D2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
.Columns("C:C").Insert Shift:=xlToRight
.Range("A1", .Range("A2").End(xlDown)).Offset(, 2) _
.Formula = "=A1&"",""&B1&"",""&E1"
.Range("F1").Value = "小計"
.Range("A2", .Range("A2").End(xlDown)).Offset(, 5).Formula = "=D2*E2"
.Range("A1").CurrentRegion.Subtotal _
GroupBy:=3, Function:=xlSum, TotalList:=Array(4, 6), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
.Outline.ShowLevels RowLevels:=3
.Outline.ShowLevels RowLevels:=2
.Columns("C:F").SpecialCells(xlCellTypeVisible).Copy sh2.Range("A1")
Application.DisplayAlerts = False
.Delete
End With
Application.DisplayAlerts = True
With sh2
.Columns("B:C").Insert Shift:=xlToRight
.Columns("A:A").TextToColumns _
Destination:=.Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
.Columns("C:C").Replace _
What:=" 集計", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Columns("E:E").Delete Shift:=xlToLeft
.Columns("D:D").Cut
.Range("C1").Insert Shift:=xlToRight
.UsedRange.Font.FontStyle = "標準"
.UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
