エクセル２０００でのデータ作成で・・

質問

顧客管理のデータを入力しています。
　月日　顧客名　　　数量　累計　担当者　コード　　　　欄外
　2/14　○○○　　　　1　　 　1　　田中　　　A　　　　　 　1
　2/14　○○○　　　　1　　 　2　　田中　　　Ｂ　　　　　　2
　2/14　○○○　　　　２　　　4　　鈴木　　　　　　　　　　1
　2/15　○○○　　　　２　　　6　　鈴木　　　Ｃ　　　　　　2
　こんな感じだとします。
累計にはIF(ISBLANK(C3),"",D2+C3)のような式が入ってます。
　コードAと空欄のものと、ＢとＣとの２つの表に分けたいと
します。シート１には全体の表を、シート２にＡと空欄、シート３に
ＢとＣを表示したい時はどうしたらいいでしょうか？
　新しいデータはシート１にどんどん入力したいのです。
シート２とシート３それぞれの累計と通番号も付けたい場合、
どうやるのが一番でしょうか・・。
　今はシート１の欄外に１と2と入力してシート２に
=IF(シート１!Ｈ1=1,シート１!Ａ1,"")
と入れています。
　そうするとどうしても空白の行ができてしまい、
累計の演算式もエラーが出ます。行削除して、
通番号を付け直していますが、他に一発で隙間なく
シート２，３へ転記され、各シートごとの累計を出す方法が
ありましたらおしえてください。

回答No.1

madman · ベストアンサー

VBAマクロを使えば簡単です。暇だったんで作って見ました(^^;
作って見たので、試して見てください。
試す場合は、自己の責任に於いて行ってください。
実行により、不都合が生じても責任は取れませんので....
最低限、マスターはコピーを取って置いてください。

表示→ツールバー→コントロールツールボックスでコントロールツールボックスを表示し、ボタンをsheet１の欄外に貼り付けてください。
そのボタンをマウスでダブルクリックしてください。

マクロが表示されれば、下のプログラムを追加してください。
コントロールツールボックスを閉じ、一旦保存しExcelを終了してください。
再起動時、「マクロ云々」のメッセージが出ますので「マクロを有効にする」を選択し、起動後、ボタンを押下してみてください。

マクロは必要に応じて修正してください。

Private Sub CommandButton1_Click()
Dim Count, S2, S3, S, loopf As Integer
Dim d1, d2, d3, d4, d5, sheetbuf As String

S2 = 2
S3 = 2
Count = 2
loopf = 1
While loopf
buff = "f" & Count
aa = Range(buff).Value
d1 = Range("a" & Count).Value
d2 = Range("b" & Count).Value
d3 = Range("c" & Count).Value
d4 = Range("e" & Count).Value
d5 = Range("f" & Count).Value
If aa = "A" Or aa = "" Then
sheetbuf = "Sheet2"
S = S2
ElseIf aa = "B" Or aa = "C" Then
sheetbuf = "Sheet3"
S = S3
End If
Worksheets(sheetbuf).Range("a" & S).Value = d1
Worksheets(sheetbuf).Range("b" & S).Value = d2
Worksheets(sheetbuf).Range("c" & S).Value = d3
If S = 2 Then
Worksheets(sheetbuf).Range("d" & S).Value = Worksheets(sheetbuf).Range("c" & S).Value
Else
Worksheets(sheetbuf).Range("d" & S).Value = "=IF(ISBLANK(C" & S & "),"""",D" & S - 1 & "+C" & S & ")"
End If
Worksheets(sheetbuf).Range("e" & S).Value = d4
Worksheets(sheetbuf).Range("f" & S).Value = d5
Count = Count + 1
If aa = "A" Or aa = "" Then
S2 = S2 + 1
ElseIf aa = "B" Or aa = "C" Then
S3 = S3 + 1
End If

If d1 = "" Then
loopf = 0
End If
Wend
End Sub

お礼

感動です！VBAマクロを記述していただけるなんて思ってもいませんでした！
本当にありがとうございます！ポイントでしかお礼できないのがつらいです。
そしてなによりツライのは自分のエクセルの知識はマクロを理解できないと
いうことです（涙）。でも近いうちに必ず理解できるように、せっかく
作っていただいたものを自分で使えるように、勉強します。
　素早くそして丁寧な回答に感謝します。