コードがうまく作れません

質問

ｉの値に一致するセルをAK列のセルから探し出し、一致したら同じ行のセルＢＡ列の値を合計します。ｉの合計が出たらワークシート２にｉの値と合計をセルに貼り付けます。
次にｉの値を１増やしてまた同じセルを探し出し、合計を出してワークシートの下の行のセルへ貼り付けます。
これで実行すると合計が全て０になります。どうかご指導をお願いします。
Sub sou()
Dim h, count, goukei, i, e, f
h = 1
e = 1
f = 1
count = 0
goukei = 0
Worksheets("Sheet1").Activate
Worksheets("Sheet2").Activate
For i = 12345 To 45787
For h = 1 To Cells(Rows.count, "AK").End(xlUp).Row
If i = Cells(h, "AK") Then
count = Cells(h, "BA")
goukei = count + goukei

End If
Next h
Worksheets("sheet2").Cells(e, "A") = i
Worksheets("sheet2").Cells(f, "B") = goukei
e = e + 1
f = f + 1
Next i
End Sub

回答No.2

googoo900 · ベストアンサー

>これで実行すると合計が全て０になります。

これは、9行目でシート２をアクティベートしているため、それ以降すべてシート２を参照しています。
おそらくシート２にはデータがないので、合計はゼロになってしまいます。

コードは以下のようになります。tokotoko99321さんのコードをベースに改造して特にむずかしい構文は使っていません。

※tokotoko99321さんが作られていたようにすべてのiに対してシート２に書き出すようにしています。
iの値に一致する場合のみシート２に抜き出す場合には、コード中のコメントにも書いているとおり、行頭の『'』マークを２ヶ所削除してその行が実行されるようにしてください。

Sub sou()
Dim h, i, e, f, endrow As Integer
Dim count, goukei
h = 1
e = 1
f = 1
count = 0
goukei = 0

Worksheets("Sheet1").Activate
endrow = Cells(Rows.count, "AK").End(xlUp).Row
For i = 12345 To 45787
For h = 1 To endrow
If i = Cells(h, "AK") Then
count = Cells(h, "BA")
goukei = count + goukei
End If
Next h
'If goukei <> 0 Then 'iの値に一致するものがない場合はシート２に書き込まないのであれば、行頭の『'』を削除する
Worksheets("sheet2").Cells(e, "A") = i
Worksheets("sheet2").Cells(e, "B") = goukei
e = e + 1
'End If 'iの値に一致するものがない場合はシート２に書き込まないのであれば、行頭の『'』を削除する
goukei = 0
Next i
End Sub

お礼

丁寧に教えてくださりありがとうございます。ベストアンサーとさせていただきます。

回答No.1

watabe007

>これで実行すると合計が全て０になります。
なぜ0になるのか説明は無ですか？
Sub sou()
　　Dim i As Long, h As Long, e As Long, goukei As Long
　　Dim flg As Boolean

　　With Worksheets("Sheet1")
　　　　For i = 12345 To 45787
　　　　　　For h = 1 To .Cells(Rows.count, "AK").End(xlUp).Row
　　　　　　　　If i = .Cells(h, "AK").Value Then
　　　　　　　　　　goukei = goukei + Cells(h, "BA").Value
　　　　　　　　　　flg = True
　　　　　　　　End If
　　　　　　Next h
　　　　　　If flg = True Then
　　　　　　　　e = e + 1
　　　　　　　　Worksheets("sheet2").Cells(e, "A").Value = i
　　　　　　　　Worksheets("sheet2").Cells(e, "B").Value = goukei
　　　　　　　　goukei = 0
　　　　　　　　flg = False
　　　　　　End If
　　　　Next i
　　End With
End Sub