Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

9335 / 76732

←次へ　｜　前へ→


	【72959】Re:足し算と掛け算の入った転記方法

ウッシ - 12/10/17(水) 14:05 -


	引用なし

	パスワード

こんにちは

>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

2 hits

▼

【72956】足し算と掛け算の入った転記方法 マリモ 12/10/17(水) 10:44