地区ごとに並んだ全社員リストの地区間に列挿入マクロ

質問

社員給与のリストを作成しています。毎月の作業でもともとシステムから抽出した1人1行の給与詳細を、本社の指示により、一人3行の指定フォーマットに変えて、地区ごとの小計を出す必要があります。マクロにより1行のシステムデータを3行のフォーマットに変更するところまでは何とか調べてたどり着きました。ここで社員リストの地区ごとに小計用スペース3行を入れるマクロを組みたいんですがお知恵を貸してください。社員全体で300人位のリストで地区は20地区位ありますが、毎月の作業になるのでマクロを組みたく思っています。あまりマクロは詳しくないのでなるべく難しくない形のマクロを教えていただければ助かります。例えば東京を数字の１、大阪を２とかに変えてから作業とかでもかまいません。マクロ変換前の例として簡単な形のエクセルを添付しました。

回答No.1

keithin · ベストアンサー

作成例：
エクセルに取り込んだところから
たとえば
Ａ列に地区
Ｂ列に社員番号
Ｃ列に名前
Ｄ，Ｅ，Ｆ列に最初の３項目
Ｇ，Ｈ，Ｉ列に次の３項目
１行目はタイトル行
２行目からまだ一人１行ずつのデータ

sub macro1()
　dim r as long

’地区で並べ替える　既に並べ替えられているなら省略する
　range("A1").currentregion.sort key1:=range("A1"), order1:=xlascending, header:=xlyes

　’先に地区小計を１行形式で挿入する
　range("A1").currentregion.subtotal groupby:=1, function:=xlsum, totallist:=array(4,5,6,7,8,9), replace:=true, pagebreaks:=false, summarybelowdata:=true
　range("A1").currentregion.value = range("A1").currentregion.value

　’そのあと各１行を３行にする
　for r = range("A65536").end(xlup).row to 2 step -1
　　cells(r + 1, "A").resize(2, 1).entirerow.insert
　　cells(r + 1, "D") = cells(r, "E")
　　cells(r + 2, "D") = cells(r, "F")
　　cells(r + 1, "G") = cells(r, "H")
　　cells(r + 2, "G") = cells(r, "I")
　next r

　range("H:I").delete shift:=xlshifttoleft
　range("E:F").delete shift:=xlshifttoleft
end sub

回答した通りにサンプルのレイアウトを実際に作成して、動作を確認してください
そのあと、実際のレイアウトに応じて自力で適切に応用してください。