合計金額を出力するマクロについて知りたい

質問

Ｅ・Ｆ列は既に入力されています。
下記のようにＧ列・Ｈ列にマクロで出力できるようにしたいのです

■例
－－－－E－－－－－F－－－－－G－－－－－－－H
07－－名前Ａ －－金額－－－名前Ａ－－－名前Ａの合計金額
08－－空白－－－金額－－－名前Ｂ－－－名前Ｂの合計金額
09－－名前B －－金額－－－名前Ｃ－－－名前Ｃの合計金額
10－－空白－－－金額－－－合計－－－名前Ａ～名前Ｃの合計金額
11－－空白－－－金額
12－－名前C －－金額
13－－合計－－合計金額

ご教授お願い致しますm(_ _)m

回答No.4

keithin · ベストアンサー

＞下記のところでエラーがでます。

どんなエラーが出たのか不明なので詳しい事は判りませんが，恐らくあなたの実際のワークシートが，ご相談で書かれている内容とは違ってるのが原因です。

変更前：
cells(n, "H") = cells(n, "H") + cells(r, "F")

変更後：
cells(n, "H") = application.sum(cells(n, "H"), cells(r, "F"))

＃具体的に「このマクロの行で」「こんな風に書かれてるエラーが現れた」「どこまで進んでマクロが止まった」「止まったときのワークシートはこんな内容が記入されている」などのように，目に見える様子を何でも詳しくご質問に書いて下さい。

お礼

すみません。
cells(n, "H") = application.sum(cells(n, "H"), cells(r, "F"))
で解決しました。

宣言した定数が一つ異なっているという単純なミスでした（＞＜）
何度もご丁寧に本当に、ありがとうございました。

補足

エラー箇所→ cells(n, "H") = application.sum(cells(n, "H"), cells(r, "F"))
エラー出力→「実行時エラー１００４：アプリケーション定義またはオブジェクト定義のエラーです」
止まったときのワークシートには、名前Ａだけが出力されています。

何度も申し訳ないですが、ご教授お願いします。

回答No.5

n-jun

Ｎｏ１です。

エラーが出ますだけでは・・・

記載している情報と実際のセル位置が違うとか、
金額には”円”がついているとか、
どこかセルを結合しているとかなどの
問題じゃないかな？？？？

お礼

返答ありがとうございました。

＞＞エラーが出ますだけでは・・・
おっしゃる通りです（＞＜） ですが、
誠に勝手ですが、自分の知識不足により、エラー原因追求が
できない状態でした。

２度もご返答ありがとうございました。

回答No.3

bin-chan

マクロでなく、sumif関数で実現できます。

セルＨ７に式[=sumif(E7:E12,"=名前Ａ",F2:F12)]
セルＨ８に式[=sumif(E7:E12,"=名前Ｂ",F2:F12)]
セルＨ９に式[=sumif(E7:E12,"=名前Ｃ",F2:F12)]
セルＨ９に式[=sum(H7:H9]
を設定。

補足

ご回答ありがとうございます。
残念ながら、名前は変動しますので、関数ではできないんです。
説明不足で、すみません。

回答No.2

keithin

７行目から金額が記入してある前提で。

sub macro1()
　dim r as long
　dim n as long
　n = 6
　range("H7:H65536").clearcontents

　for r = 7 to range("E65536").end(xlup).row
　　if cells(r, "E") <> "" then
　　　n = n + 1
　　　cells(n, "G") = cells(r, "E")
　　end if
　　cells(n, "H") = cells(n, "H") + cells(r, "F")
　next r
end sub
みたいな。

補足

ご回答ありまがとうございます。
分かりやすいプログラムだったのですが、下記のところで
エラーがでます。原因について考えたのですが、分かりません。
お手数ですが、どのようなプログラムを入力すればよいのか、
ご教授お願いできないでしょうか？
宜しかったらお願いします（＞＜）

cells(n, "H") = cells(n, "H") + cells(r, "F")

回答No.1

n-jun

Sub try()

Dim myDic As Object
Dim r As Range
Dim st As String
Dim v As Variant

Set myDic = CreateObject("Scripting.Dictionary")

For Each r In Range("E7", Cells(Rows.Count, 5).End(xlUp))

st = IIf(r.Value <> "", r.Value, st)

If Not myDic.Exists(st) Then
myDic(st) = Array(r.Value, r.Offset(, 1).Value)
Else
v = myDic(st)
v(1) = Val(v(1)) + r.Offset(, 1).Value
myDic(st) = v
End If

Next

Range("G7").Resize(myDic.Count, 2).Value = _
Application.Transpose(Application.Transpose(myDic.Items))

Set myDic = Nothing

End Sub

一例になれば。

補足

ご回答ありがとうございます。
ご回答いただいて申し訳ないですが、エラー表示されてしまいます。
配列で構成しているのではと思い考えてみましたが、やはり理解できず。
配列苦手で（＾＾；） すみません（＞＜）

配列で構成したほうが一番いいと思うので、配列についてはもう少し勉強し直します。