ＥＸＣＥＬで家計簿作成 カテゴリごとに金額の合計を算出する方法がわかりません

EXCELマクロ初心者です。EXCEL2002で家計簿を作成しています。
　Ａ　　　Ｂ　　Ｃ
１内科　　医者　１０００
２弁当　　食費　　８００
３歯医者　医者　　５００
４おにぎり食費　　２００
５　　　　end
上記内容をＥＸＣＥＬに入力します。
Ａ欄は品目、Ｂ欄はカテゴリ、Ｃ欄は金額を入力します。
これを、マクロを使ってＢ欄ごとに合計金額を算出したいのです。
完成イメージは以下のとおりです。

医者　１５００
食費　１０００

因みに、以下のようにコーディングしてみましたが、うまくいきません。
Sub ボタン1_Click()
Dim mykategori
Dim myisyakingaku
Dim mysyokuhikingaku
Range("b1").Select
Do Until ActiveCell.Value = "end"
mykategori = ("b1")
If mykategori = "医者" Then
myisyakingaku　= myisyakingaku+ ("c1")・・・(1)
ElseIf mykategori = "食費" Then
mysyokuhikingaku = mysyokuhikingaku + ("C2")・・・(2)
End If
ActiveCell.Offset(1).Select

Range("D1") = myisyakingaku・・・(3)
Range("D2") = mysyokuhikingaku・・・(3)
Loop
End Sub

(1)(2)が間違っているのはよくわかっているのですが、
金額の座標軸を１つずつ下にずらす方法がわかりません。
座標軸を１つずつずらす方法を教えて下さい。
そもそも、こんなコーディングしないよ！もっと良い方法があるよ！という場合は、上記のコーディングは無視してコディング例を教えていただきたいと思います。

なお、(3)は合計金額を仮表示するために空いている箇所に適当に
表示させるためにコーディングしたものです。
あまり気にしなくて結構です。

以上、宜しくお願い致します。

No.3 ベストアンサー 回答者： hallo-2007 回答日時： 2008/09/14 18:40

>金額の座標軸を１つずつ下にずらす方法がわかりません。

Cells(ActiveCell.Row, 3).Value
と記述する方法もあります。
IF文ですが　CASE文がわかりやすいかも
勉強の材料として
Range("D1").Value = 0
Range("D2").Value = 0
Range("b1").Activate
Do Until ActiveCell.Value = "end"
Select Case ActiveCell.Value
Case "医者"
Range("D1").Value = Range("D1").Value + Cells(ActiveCell.Row, 3).Value '・・・(1)
Case "食費"
Range("D2").Value = Range("D2").Value + Cells(ActiveCell.Row, 3).Value '・・・(2)
End Select
ActiveCell.Offset(1).Activate
Loop
End Sub

他方法ですが、この様な集計ならば
一般機能の　ピボットテーブル　或いは巻数で（SUMIFなど）で十分ですよ。

この回答へのお礼

コーディングして実行したところ、
完成イメージ通りの結果が得られました。
ありがとうございます！

お礼日時：2008/09/15 14:06

No.4 回答者： imogasi 回答日時： 2008/09/17 13:01

こんなエクセルの処理を繰り返し法でやるより

（１）ピボットテーブル
（２）関数利用
などでやるのがよいと思う。
ーー
同じ繰り返し法でも、下記のやり方をやってみて、よさを勉強して。
質問者のいう「カテゴリ」が表（コードのおもて）に出ないが、存在するだけ集計するよ。
例データ
A列　　　B列　　　C列
内科医者1000
弁当食費800
歯医者医者500
おにぎり食費200
靴下衣類500
パンツ衣類1000
会食交際費4000
授業料学費30000
授業料学費40000
弁当食費1000
データの終わりにENDなど入れないものだ。
ーー
標準モジュールに
Sub test01()
d = Range("A65536").End(xlUp).Row
d2 = Range("H65536").End(xlUp).Row
For i = 2 To d
For k = 1 To d2
If Cells(i, "B") = Cells(k, "H") Then
Cells(k, "I") = Cells(k, "I") + Cells(i, "C")
GoTo p1
Else
End If
Next k
d2 = d2 + 1
Cells(d2, "H") = Cells(i, "B")
Cells(d2, "I") = Cells(i, "C")
p1:
Next i
End Sub
ーーー
結果
H列　I列
医者1500
食費2000
衣類1500
交際費4000
学費70000

No.2 回答者： n-jun 回答日時： 2008/09/14 17:56

提示されたコードを修正するのなら、

Sub ボタン1_Click()
Dim mykategori As String
Dim myisyakingaku As Double
Dim mysyokuhikingaku As Double
Dim myrow As Long

myrow = 1
Do Until Range("B" & myrow).Value = "end"
mykategori = Range("B" & myrow).Value
If mykategori = "医者" Then
myisyakingaku = myisyakingaku + Range("C" & myrow).Value
ElseIf mykategori = "食費" Then
mysyokuhikingaku = mysyokuhikingaku + Range("C" & myrow).Value
End If
myrow = myrow + 1
Loop

Range("D1").Value = "医者"
Range("E1").Value = myisyakingaku
Range("D2").Value = "食費"
Range("E2").Value = mysyokuhikingaku
End Sub
こんな感じではないかと。

この回答へのお礼

コーディングして実行したことろ、医者、食費等の見出しが付与されるのですね。見易いです。
ありがとうございました！

お礼日時：2008/09/15 14:10

No.1 回答者： n-jun 回答日時： 2008/09/14 17:20

Ｂ列最後の”end”は消して下さい。

結果はＥ列・Ｆ列に出します。

Sub　test()
　Dim　Dic　As　Object
　Dim　i　As　Long
　Dim　v　As　Variant

　Set　Dic　=　CreateObject("Scripting.Dictionary")

　With　ActiveSheet
　　　　　　v　=　.Range(.Range("B1"),　.Cells(Rows.Count,　3).End(xlUp)).Value
　　　　　　For　i　=　1　To　UBound(v,　1)
　　　　　　　　　　Dic(v(i,　1))　=　Dic(v(i,　1))　+　v(i,　2)
　　　　　　Next
　　　　　　.Range("E1").Resize(Dic.Count,　1).Value　=　Application.Transpose(Dic.keys)
　　　　　　.Range("F1").Resize(Dic.Count,　1).Value　=　Application.Transpose(Dic.items)
　End　With
　Set　Dic　=　Nothing
　Erase　v
End　Sub
ご参考程度に。

この回答へのお礼

コーディングして実行したところ、イメージ通りの結果が得られました。ただ、私がこのようなコーディングをするにはまだまだスキル不足かなと感じました。ＶＢＡの本を片手に解析し、理解を深めたいと考えています。
ありがとうございました！

お礼日時：2008/09/15 14:13