VBAコードが作動せず、どこに問題があるのか教えて下さい。

商品の受払を入力シートからA商品券受払帳に転記したいのですが、作動しません。なお、コードは次のとおりです。sheetの画面は添付のとおりです。入力シートから受払帳の黄色の部分以下行に「月、日に日付、摘要に「ｋ商店」、発行高の枚数」が最小限転記できるようにと設定したいと考えました。
試行錯誤しましたが、作動せず修正箇所がわかりません。教えて下さい。

Set sh10 = Worksheets("A商品券受払帳")
Set sh1 = Worksheets("入力シート")

If Not IsDate(Range("G5").Value) Then Exit Sub
Select Case Month(Range("G5").Value)

Case 4: mRow = 1
Case 5: mRow = 35

Case 6: mRow = 68
Case 7: mRow = 82
Case 8: mRow = 109
Case 9: mRow = 139
Case 10: mRow = 173
Case 11: mRow = 187
Case 12: mRow = 211
Case 1: mRow = 227
Case 2: mRow = 260
Case 3: mRow = 318
End Select
Call cashbook_main(mRow)
End Sub

Public Sub cashbook_main(mRow As Long)
Dim sh10 As Worksheet
Dim sh1 As Worksheet
Dim maxrow As Long
Dim Row As Long
Dim dicT As Object
Dim key As Variant
Set sh10 = Worksheets("A商品券受払帳")
Set sh1 = Worksheets("入力シート")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh1.Cells(Rows.Count, "H").End(xlUp).Row

For Row = 2 To maxrow
key = sh10.Cells(Row, "G").Value
dicT(key) = Row

Next
key = sh1.Cells(2, "Q").Value
If dicT.exists(key) = False Then
MsgBox ("伝票番号=" & key & "は商品券受払にありません")
Exit Sub
End If

If sh1.Cells(18, "M").Value = "" Then
sh1.Cells(Row, "G") = ""
MsgBox ("枚数が未表示です")
Exit Sub
End If

Row = dicT(key)
sh10.Cells(Row + mRow, "F").Value = sh1.Cells(7, "C").Value '名前
sh10.Cells(Row + mRow, "B").Value = sh1.Cells(5, "I").Value '年月日
sh10.Cells(Row + mRow, "G").Value = sh1.Cells(2, "Q").Value '伝票番号

MsgBox ("A商品券受払帳に転記します")

End Sub

No.1 ベストアンサー 回答者： fujillin 回答日時： 2023/06/13 14:08

こんにちは

添付図の 行番号・列番号 がよく読めないのと、結合セルがあるのではっきりとはわからないのですが・・
また、ご提示のコードでは、ご説明の文章にはない処理を含んでいるようなので、なさりたいことがよくわかりません。

とりあえず、
＞maxrow = sh1.Cells(Rows.Count, "H").End(xlUp).Row
で「入力シート」のH列の最終号を求めて、

＞For Row = 2 To maxrow
＞key = sh10.Cells(Row, "G").Value
「A商品券受払帳シート」の2行目から、上記の（入力シートの）最終行まで処理をしているのが妙ですけれど？
しかも、G列の値（＝H列ではなく）を参照するようになっていますが・・？
また、どちらのシートとも2行目って、ほとんど検索するのには関係のない情報のような気がしますので、最終行だけでなく開始行（＝2行目）もおかしくないのでしょうか？


なお、ご質問には関係ありませんけれど・・・
Dictionary オブジェクトを利用して検索しているようですが、一回だけの検索のようですので、Forループで直接検索するか、あるいはFindメソッドで検索してしまう方が簡単だし、効率が良いように感じます。

この回答へのお礼

有り難う御座いました。もう一度、修正し直します。

お礼日時：2023/06/13 16:20

No.3 回答者： tatsumaru77 回答日時： 2023/06/14 09:32

１．画像が不鮮明なので、各セルの正確な位置、及び内容が読み取れません。

gazo.comへアップされてはいかがでしょうか。
下記はアップしたサンプルです。（画像の内容は本件とは関係ありません）
https://gyazo.com/12c2ce039112604bd5c44d964fc29287

又、アップの際は、入力シートとA商品券受払帳を別々にアップされた方が判りやすいです。


２．下記の行の
If Not IsDate(Range("G5").Value) Then Exit Sub
のG5セルは、入力シートのG5セルでしょうか。それとも
A商品券受払帳のG5セルでしょうか。

この回答へのお礼

有り難う御座います。もう一度、画像や添付方法を見直します。ご質問の
＞If Not IsDate(Range("G5").Value) Then Exit Sub
のG5セルは、・・・・の件は、「入力シートのG5セル」です。
Call cashbook_main(mRow)のところをCall giftbook_main(mRow)としても可能ならば、Public Sub giftbook_main(mRow As Long)と修正します。
なお、コードのmaxrow = sh1.Cells(Rows.Count, "H").End(xlUp).Rowのところで、”H"を設定いませんでした。コピぺのコードのとおりの入力シートではありませんでした。他にもミスがありましたので、見直し、修正のうえ改めてご質問させて頂こうと思います。
ご丁寧に対応して頂き有り難う御座いました。

お礼日時：2023/06/14 17:10

No.2 回答者： ssawatake 回答日時： 2023/06/13 14:32

中身は詳しく見てませんが、

Public Sub cashbook_main(mRow As Long)で、mRowはlong型を指定してるのも関わらず、呼び出し元では何も型指定して無いので、variant型です。

呼び出し元で、
dim mRow As Longの型宣言が要ります。

この回答へのお礼

有り難う御座いました。修正いたします。

お礼日時：2023/06/13 16:12