Excel 大量データの指定箇所に行を挿入するには？？

質問

会社でExcel作業中なのですが、、、ど～してもわからず
悪戦苦闘しています(>_<)　どなたか助けて下さい！

やりたいことはこんな感じです。
今の段階では得意先ごとにA項目からG項目まで並んでいます。
最終的には、得意先ごとに
「C・D項目合計」「E・F項目合計」「A・B・C・D・E・F・G項目合計」
という行を追加で挿入し、それぞれの合計値を出したいのです。

良い方法が思いつかなかったので、右クリックして
挿入を延々と繰り返し、その後計算式をコピーして入れていましたが
データが5万件ほどあり（ブックが別れています）、永遠に
終わりそうもありません。。

どなたか解決法をご存知でしたら教えて下さい！宜しくお願い致しますm(__)m

☆作業前↓-----------------------

A得意先 A項目　　　　　　　　　　　 10
　　　　　　　B項目　　　　　　　　　　　 20
C項目　　　　　　　　　　　 30
D項目　　　　　　　　　　　 35
E項目　　　　　　　　　　　 15
F項目　　　　　　　　　　　 25
G項目　　　　　　　　　　　　　 10
B得意先 A項目　　　　　　　　　　　 10
　　　　　　　B項目　　　　　　　　　　　 20
C項目　　　　　　　　　　　 30
D項目　　　　　　　　　　　 35
E項目　　　　　　　　　　　 15
F項目　　　　　　　　　　　 25
G項目　　　　　　　　　　　　　 10

☆作業後↓-----------------------

A得意先 A項目　　　　　　　　　　　 10
B項目　　　　　　　　　　　 20
C項目　　　　　　　　　　　 30
D項目　　　　　　　　　　　 35
C・D項目合計　　　　　　　 65
E項目　　　　　　　　　　　 15
F項目　　　　　　　　　　　 25
E・F項目合計　　　　　　　　　 40
G項目　　　　　　　　　　　　　 10
A・B・C・D・E・F・G項目合計　 145
B得意先 A項目　　　　　　　　　　　 10
B項目　　　　　　　　　　　 20
C項目　　　　　　　　　　　 30
D項目　　　　　　　　　　　 35
C・D項目合計　　　　　　　 65
E項目　　　　　　　　　　　 15
F項目　　　　　　　　　　　 25
E・F項目合計　　　　　　　　 40
G項目　　　　　　　　　　　　　 10
A・B・C・D・E・F・G項目合計　 145

回答No.8

merlionXX · ベストアンサー

sakura0411さん、こんにちは。merlionXXです。
今日はポカポカで春のようです。（東京は）

では、「ラジオスポット計」行の１行下の項目が「交通」じゃない場合、新たに行を追加し、交通という項目にすればいいんですね？
単純にその作業を行なうだけでしたらこれを試してください。

Sub 交通行挿入()

Dim t As Date '変数ｔは日付時間と宣言
Dim k As Range '変数kは範囲と宣言

t = Now() '現在時間をｔに代入

With ActiveSheet 'アクティブなシートにおいて

Set k = .Range("B1") 'とりあえず項目列のセルB1をｋと定義する

Do Until k.Value = "" And k.Offset(1, 0).Value = "" '項目列に2行連続で空白があったら中止
Set k = k.Offset(1, 0) 'ｋの一つ下のセルをあたらにｋと定義する

If Trim(k.Value) = "ラジオスポット計" Then 'kがラジオスポット計なら
If Trim(k.Offset(1, 0).Value) <> "交通" Then 'もしｋの下が「交通」でなければ
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown 'ｋの下に1行挿入
k.Offset(1, 0).Value = "　交通" '項目を入れる
.Range(k.Offset(1, 1), k.Offset(1, 35)).Value = 0 'その行の値を0とする
End If
End If

Loop '繰り返す

End With

MsgBox UCase(Environ("UserName")) & "さん、作業所要時間は、" & Format(Now() - t, "hh時間mm分ss秒") & " でした。。" '今の時間からｔを引いて作業時間を求めユーザーに案内

End Sub

さきほどの集計作業も同時に行なうのでしたら、こちらを

Sub 集計および交通行補正()

Dim t As Date '変数ｔは日付時間と宣言
Dim k As Range '変数kは範囲と宣言

t = Now() '現在時間をｔに代入

With ActiveSheet 'アクティブなシートにおいて

Set k = .Range("B1") 'とりあえず項目列のセルB1をｋと定義する

Do Until k.Value = "" And k.Offset(1, 0).Value = "" '項目列に2行連続で空白があったら中止
Application.StatusBar = k.Address 'ステータスバーにkのアドレス表示
Set k = k.Offset(1, 0) 'ｋの一つ下のセルをあたらにｋと定義する

If Trim(k.Value) = "テレビスポット計" Then 'kがテレビスポット計なら
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown 'ｋの下に1行挿入
k.Offset(1, 0).Value = "　テレビ（タイム・スポット計）" '項目を入れる
.Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)" 'その行に式を挿入
End If

If Trim(k.Value) = "ラジオスポット計" Then 'kがラジオスポット計なら
If Trim(k.Offset(1, 0).Value) <> "交通" Then 'ｋの下が交通でなければ
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown 'ｋの下に1行挿入
k.Offset(1, 0).Value = "　交通" '項目を入れる
.Range(k.Offset(1, 1), k.Offset(1, 35)).Value = 0 'その行の値を0とする
End If
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown 'ｋの下に1行挿入
k.Offset(1, 0).Value = "　ラジオ（タイム・スポット計）" '項目を入れる
.Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)" 'その行に式を挿入
End If

If Trim(k.Value) = "交通" Then 'ｋが交通なら
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown 'ｋの下に1行挿入
k.Offset(1, 0).Value = "合計" '項目を入れる
.Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-9]C:R[-1]C)" 'その行に式を挿入
End If

Loop '繰り返す

End With

MsgBox UCase(Environ("UserName")) & "さん、作業所要時間は、" & Format(Now() - t, "hh時間mm分ss秒") & " でした。。" '今の時間からｔを引いて作業時間を求めユーザーに案内

Application.StatusBar = "" 'ステータスバー表示を消去

End Sub

マクロコードの各行が何をしているのかコメントを付しておきました。（'でコメントアウトしてますからそのままコピペしても大丈夫ですよ。）

お礼

merlionXXさんへ

こんにちは！sakura0411です。
早速のお返事どうも有難うございました！
今日は東京はとても暖かくて気持ちの良い日ですね♪
（お互い東京に住んでいるんですネ）

マクロの方実行してみました。今回も完璧です！
しかもユーザー名が出たり、所要時間が出たり、バージョンアップしてますねっ？？
何が書いてるのかわからなかったマクロも、merlionXXさんが
コメントして下さったおかげでなんとなく理解できました♪
頑張って勉強せねば！
本当に有難うございました。

当初は2週間以上かかるのでは…と思っていた作業も
これなら2日とかでできちゃいそうです。
どうも有難うございました。大感謝です☆
取り急ぎお礼まで o(*^_^*)o

回答No.7

merlionXX

こんばんは、merlionXXです。

> A～Gの全て（9項目）の合計ではなくて、
> A～Gの7項目（C・D項目合計とE・F項目合計の行は除く）の
> 合計にするにはどうすればよいのでしょうか？？

え？そうなっていませんか？
使用したSUBTOTAL関数は途中のSUBTOTALを自動的に対象から除外しています。ですからC11セルは=SUBTOTAL(9,C2:C10)となっていると思いますが、C2～C10の合計ではなく、途中のSUBTOTAL行は抜いて計算しているはずですよ。確認願います。

> 作業前にG項目がなく、マクロで追加したい場合には

よく意味がわかりません。
「交通」という項目がないデータに「交通」の行を追加するのですか？
ではそこのデータはどこから持ってくるのですか？

補足

merlionXXさんへ

おはようございます！sakura0411です。

色々ご迷惑をおかけしてスミマセン。。

> 使用したSUBTOTAL関数は途中のSUBTOTALを自動的に対象から除外しています。ですからC11セルは=SUBTOTAL(9,C2:C10)
> となっていると思いますが、C2～C10の合計ではなく、途中のSUBTOTAL行は抜いて計算しているはずですよ。確認願います。

上記の件、ちゃんと計算されていました。SUBTOTALで全部計算されてしまうものと勘違いしてしまいました。
大変失礼しました、ごめんなさいっm(__)m

>> 作業前にG項目がなく、マクロで追加したい場合には
>
> よく意味がわかりません。
> 「交通」という項目がないデータに「交通」の行を追加するのですか？
> ではそこのデータはどこから持ってくるのですか？

これも言葉が足りずにスミマセン（汗）
merlionXXさんのおっしゃる通り、現在「交通」という項目がないデータに
「交通」という行を追加したいのです。

かなり昔のデータになると、「交通」の項目がなく、数値も紙のみで
最終的には手入力しなければいけないことになってしまったんです。。(ToT)

なので、データ入力は手作業でやるとしても、行の挿入の部分は
自動でできないものかと思いまして。。

自分でやってみたんですが、エラーになってしまうしよくわからなくて（汗）
そんなに急ぎではないので、もし可能であれば教えて頂けたら嬉しいです。
重ね重ね甘えてしまって申し訳ありませんが、どうぞ宜しくお願い致します。

回答No.6

merlionXX

すみません、訂正です。

Sub test03()
Dim k As Range
With ActiveSheet
Set k = .Range("B1")
Do Until k.Value = "" And k.Offset(1, 0).Value = ""
Set k = k.Offset(1, 0)
If Trim(k.Value) = "テレビスポット計" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "　テレビ（タイム・スポット計）"
.Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If Trim(k.Value) = "ラジオスポット計" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "　ラジオ（タイム・スポット計）"
.Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If Trim(k.Value) = "交通" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "合計"
.Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-9]C:R[-1]C)"
End If
Loop
End With
End Sub

補足

スミマセン、、、お忙しいとは存じますが
追加で質問させていただいてもよろしいですか？？

最後の行に合計値を入れる箇所なのですが、
A～Gの全て（9項目）の合計ではなくて、
A～Gの7項目（C・D項目合計とE・F項目合計の行は除く）の
合計にするにはどうすればよいのでしょうか？？
自分でやろうと思ったのですが、マクロがエラーになってしまい
上手く行かず・・・。
手作業でもできるのですが、せっかくなので教えて頂ければと。
甘えてしまってすみませんが、教えて頂けると嬉しいです。
宜しくお願いします☆

それと…これ、追加質問になってしまうのですが、
作業前にG項目がなく、マクロで追加したい場合には
どうすればよいのでしょうか・・・？？？
（そういうデータがたくさん出て来てしまって困ってます(ノ_・、)
お時間のある時で構わないので、ご回答お待ちしています。
宜しくお願いします！

☆作業前↓-----------------------

A得意先 A項目　　　　　　　　　　　 10
　　　　　　　　 B項目　　　　　　　　　　　 20
C項目　　　　　　　　　　　 30
D項目　　　　　　　　　　　 35
E項目　　　　　　　　　　　 15
F項目　　　　　　　　　　　 25

☆作業後↓-----------------------

A得意先 A項目　　　　　　　　　　　 10
B項目　　　　　　　　　　　 20
C項目　　　　　　　　　　　 30
D項目　　　　　　　　　　　 35
C・D項目合計　　　　　　　 65
E項目　　　　　　　　　　　 15
F項目　　　　　　　　　　　 25
E・F項目合計　　　　　　　　　 40
G項目　　　　　　　　　　　　　 10
A・B・C・D・E・F・G項目合計　145

回答No.5

merlionXX

sakura0411さん、こんにちは。merlionXXです。
項目名の前にスペースが入っていたのですね。
では、データの項目名はいじらず、以下のマクロを実行してみてください。
今度は大丈夫かな。

Sub test02()
Dim k As Range
With ActiveSheet
Set k = .Range("B1")
Do Until k.Value = "" And k.Offset(1, 0).Value = ""
Set k = k.Offset(1, 0)
If Trim(k.Value) = "テレビスポット計" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "テレビ（タイム・スポット計）"
.Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If Trim(k.Value) = "ラジオスポット計" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "ラジオ（タイム・スポット計）"
.Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If Trim(k.Value) = "交通" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "合計"
.Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-9]C:R[-1]C)"
End If
Loop
End With
End Sub

お礼

merlionXXさんへ

早速のご回答ありがとうございました♪
素晴らしすぎます！完璧です！！天才です！！

どうやったらこういうマクロが作れるのかが
まだまだ疑問ですが。。。
頑張って勉強しなくては。。

本当にありがとうございました。
これで作業が大幅に軽減できます。大感謝です☆☆☆

回答No.4

merlionXX

追伸
データが入ってるシートを開いてる状態でやってください。

補足

回答ありがとうございました（*^_^*）

で、ですが、セキュリティのレベルも「低」にしてあるのに
全くマクロが反応しません。。エラーになるのならともかく、
どこか間違ってるんでしょうか…？？
色々トライしてみたのですが、原因はさっぱりわからずです。

自分で書き換えたのがこのマクロ↓です。。

もし間違いがあれば指摘していただけないでしょうか。。
お手数をおかけしますが、どうぞ宜しくお願いします！！！

Sub test02()
Dim k As Range
With ActiveSheet
Set k = .Range("B1")
Do Until k.Value = "" And k.Offset(1, 0).Value = ""
Set k = k.Offset(1, 0)
If Trim(k.Value) = "　テレビスポット計" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "　テレビ（タイム・スポット計）"
Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If Trim(k.Value) = "　ラジオスポット計" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "　ラジオ（タイム・スポット計）"
Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If Trim(k.Value) = "　交通" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "合計"
Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-9]C:R[-1]C)"
End If
Loop
End With
End Sub

回答No.3

merlionXX

エクセルの、メニューから、「ツール」、「マクロ」、「セキュリティ」でマクロのセキュリティレベルを見てください。
「高」になっていると作動しません。

回答No.2

merlionXX

> 顧客の名前がA列に入っており、B列に項目名、C列には2005年1月の数値、D列には2005年2月の数値…というふうに、AK列までデータが入っています。。

#1のmerlionXXです。
なるほど巨大なデータですね。マクロしか方法がないでしょう。

確認ですが、1行目は項目名で、データは2行目からですね？
顧客と顧客の間に空白行は無いか、あっても1行ですね？
B列の項目名の途中に2行以上の空白行はないですね？
列はAK列まででいいんですね？

上記でよければ、必ずバックアップをとってから以下の手順をためしてみてください。

わたしのマクロのコードで項目名を正しいものに直したら

1.AltキーとF11キーを同時に押してVisualBasicEditorを呼び出します。

2.メニューから挿入、標準モジュールで、出てきたコードウィンド（右側の白い広い部分）に以下のコードをコピペします。

Sub test02()
Dim k As Range
With ActiveSheet
Set k = .Range("B1")
Do Until k.Value = "" And k.Offset(1, 0).Value = ""
Set k = k.Offset(1, 0)
If Trim(k.Value) = "D項目" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "CD項目合計"
Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If Trim(k.Value) = "F項目" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "EF項目合計"
Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If Trim(k.Value) = "G項目" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "ABCDEFG項目合計"
Range(k.Offset(1, 1), k.Offset(1, 35)).FormulaR1C1 = "=SUBTOTAL(9,R[-9]C:R[-1]C)"
End If
Loop
End With
End Sub

3.Alt+F11キーでワークシートへもどります。

4.メニューから、ツール、マクロ、マクロで出てきたマクロ名（test02）を選択して実行します。

補足

ありがとうございます♪

でも…マクロは作れたのに、実行ボタンを押しても何も反応しません（汗）
データが入ってるシートを開いてる状態だとダメなのかな？と思い
新規のワークシートで同じ事を試みましたが、反応しませんでした(ToT)
項目名は変更しましたし、↓の確認事項も問題はないのですが。。

>確認ですが、1行目は項目名で、データは2行目からですね？→はい
>顧客と顧客の間に空白行は無いか、あっても1行ですね？→ないです
>B列の項目名の途中に2行以上の空白行はないですね？→ないです
>列はAK列まででいいんですね？→はい

マクロを実行する際に、何か設定？条件などはあるんでしょうか？
急いでいないので、お暇な時にでも教えて下さい。
お手数をおかけしますが、どうぞ宜しくお願い致します！

回答No.1

merlionXX

すべてのデータをA列とB列だけの縦でもっているのですか？
普通は顧客ごとに各項目を横に持ちませんか？
これは関数でどうこうするようなレベルじゃないですね。

項目名称がA列、数値がB列、お書きになってるとおりだとして、かならずバックアップを取ってから標準モジュールに以下のマクロを適宜修正（項目名称）したものを貼ってためしてみてください。

Sub test01()
Dim k As Range
With ActiveSheet
Set k = .Range("A1")
Do Until k.Value = "" And k.Offset(1, 0).Value = ""
Set k = k.Offset(1, 0)
If k.Value Like "*D項目" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "CD項目合計"
k.Offset(1, 1).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If k.Value Like "*F項目" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "EF項目合計"
k.Offset(1, 1).FormulaR1C1 = "=SUBTOTAL(9,R[-2]C:R[-1]C)"
End If
If k.Value Like "*G項目" Then
k.Offset(1, 0).EntireRow.Insert Shift:=xlDown
k.Offset(1, 0).Value = "ABCDEFG項目合計"
k.Offset(1, 1).FormulaR1C1 = "=SUBTOTAL(9,R[-9]C:R[-1]C)"
End If
Loop
End With
End Sub

補足

言葉足らずでスミマセン(ToT)
顧客の名前がA列に入っており、B列に項目名、C列には2005年1月の数値、D列には2005年2月の数値…というふうに、AK列までデータが入っています。。
やはり、マクロでの解決となるんですね。勉強しなくては。。(-_-;)