
Sh1(入力シート)のI25セルに枚数、K25セルに金額等のデータをSh4(A9引換帳)の
G列、Q列等に転記するコードですが、Sh4に表示されません。次のコードのどこに原因があるか教えて下さい。なお、都合上 画像を添付できない旨ご理解ください。
Sub A9引換帳()
Dim mRow As Long
If Not IsDate(Range("I8").Value) Then Exit Sub ' セルI8の値が日付でない場合、サブルーチンを終了する
Select Case Month(Range("I8").Value) ' セルI8の値が日付である場合、その月を取得する
' 以下に各月ごとの処理を記述する
Case 4: mRow = 1 ' 4月の場合の処理をする、以下同じ
Case 5: mRow = 38
Case 6: mRow = 95
Case 7: mRow = 139
Case 8: mRow = 176
Case 9: mRow = 218
Case 10: mRow = 265
Case 11: mRow = 307
Case 12: mRow = 349
Case 1: mRow = 393
Case 2: mRow = 433
Case 3: mRow = 475
End Select
Call Giftbook_main(mRow)
End Sub
Public Sub Giftbook_main(mRow As Long)
Dim sh4 As Worksheet
Dim sh1 As Worksheet
Dim maxrow As Long
Dim Row As Long
Dim dicT As Object
Dim key1 As Variant
Dim key2 As Variant
Dim mRow As Long
Dim lastRow As Long ' 最後の記録行を追跡する変数
Set sh4 = Worksheets("A9引換帳")
Set sh1 = Worksheets("入力シート")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh1.Cells(Rows.Count, "E").End(xlUp).Row 'E伝票番号(一連番号)
For Row = 8 To maxrow '8行から最終までの行
key1 = sh4.Cells(Row, "E").Value 'A9引換帳の伝票番号"E"の値の行
dicT(key1) = Row
Next
'伝票番号を記憶
key2 = sh1.Cells(8, "E").Value
dicT(key2) = Row
If dicT.exists(key2) = False Then
Exit Sub
End If
If sh1.Cells(8, "L").Value = "" Then
MsgBox ("年が未表示です")
End If
Row = dicT(key1)
If sh1.Cells(25, "I").Value = "0" Then 'A9セルの枚数が"0"ならば
sh4.Cells(Row + mRow, "F").EntireRow.Delete 'A9引換帳のF列の(Row + mRow)行目を削除する
End If
'A9引換帳に転記する。
If sh1.Cells(25, "I").Value <> "0" And sh1.Cells(25, "I").Value <> "0" Then '25行目の"I"列のセルの値が"0"でない場合
' 最後の記録行を更新
Do While sh4.Cells(lastRow + mRow + 1, "F").Value <> "" '(lastRow + mRow + 1)行目の"F"列のセルの値が空でない間、
lastRow = lastRow + 1 'lastRowの値を1ずつ増やす処理を繰り返す
Loop
lastRow = lastRow + 1
sh4.Cells(lastRow + mRow, "F").Value = sh1.Cells(12, "E").Value '名前
sh4.Cells(lastRow + mRow, "G").Value = sh1.Cells(25, "I").Value '枚数
sh4.Cells(lastRow + mRow, "D").Value = sh1.Cells(8, "N").Value '日
sh4.Cells(lastRow + mRow, "C").Value = sh1.Cells(8, "M").Value '月
sh4.Cells(lastRow + mRow, "E").Value = sh1.Cells(8, "E").Value '伝票番号
sh4.Cells(lastRow + mRow, "Q").Value = sh1.Cells(25, "K").Value '金額
End If
' 重複チェック
Dim exists As Boolean
exists = False
Dim i As Long
For i = 8 To sh4.Cells(Rows.Count, "E").End(xlUp).Row
If sh4.Cells(i, "E").Value = sh1.Cells(8, "E").Value Then
exists = True
Exit For
End If
Next i
If Not exists Then
' データを転記する
sh4.Cells(lastRow + 1, "F").Value = sh1.Cells(12, "E").Value '名前
sh4.Cells(lastRow + 1, "G").Value = sh1.Cells(25, "I").Value '枚数
sh4.Cells(lastRow + 1, "D").Value = sh1.Cells(8, "N").Value '日
sh4.Cells(lastRow + 1, "C").Value = sh1.Cells(8, "M").Value '月
sh4.Cells(lastRow + 1, "E").Value = sh1.Cells(8, "E").Value '伝票番号
sh4.Cells(lastRow + 1, "Q").Value = sh1.Cells(25, "K").Value '金額
End If
End Sub
No.1ベストアンサー
- 回答日時:
Public Sub Giftbook_main(mRow As Long) 内の
この宣言を削除。
Dim mRow As Long
ここは、andで綴っているのが同じ条件なので、条件指定間違いでなければ1つでいい。
If sh1.Cells(25, "I").Value <> "0" And sh1.Cells(25, "I").Value <> "0" Then '25行目の"I"列のセルの値が"0"でない場合
ざっくりと動作するであろう範囲でブックを作成して実行したところでは、「A9引換帳」で設定したmRow+1行目に転記されました。
実際にうまく動作しない状態のサンプルデータが検証しやすいのですが…。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
今、見られている記事はコレ!
-
弁護士が解説!あなたの声を行政に届ける「パブリックコメント」制度のすべて
社会に対する意見や不満、疑問。それを発信する場所は、SNSやブログ、そしてニュースサイトのコメント欄など多岐にわたる。教えて!gooでも「ヤフコメ民について」というタイトルのトピックがあり、この投稿の通り、...
-
弁護士が語る「合法と違法を分けるオンラインカジノのシンプルな線引き」
「お金を賭けたら違法です」ーーこう答えたのは富士見坂法律事務所の井上義之弁護士。オンラインカジノが違法となるかどうかの基準は、このように非常にシンプルである。しかし2025年にはいって、違法賭博事件が相次...
-
釣りと密漁の違いは?知らなかったでは済まされない?事前にできることは?
知らなかったでは済まされないのが法律の世界であるが、全てを知ってから何かをするには少々手間がかかるし、最悪始めることすらできずに終わってしまうこともあり得る。教えてgooでも「釣りと密漁の境目はどこです...
-
カスハラとクレームの違いは?カスハラの法的責任は?企業がとるべき対応は?
東京都が、客からの迷惑行為などを称した「カスタマーハラスメント」、いわゆる「カスハラ」の防止を目的とした条例を、全国で初めて成立させた。条例に罰則はなく、2025年4月1日から施行される。 この動きは自治体...
-
なぜ批判コメントをするの?その心理と向き合い方をカウンセラーにきいた!
今や生活に必要不可欠となったインターネット。手軽に情報を得られるだけでなく、ネットを介したコミュニケーションも一般的となった。それと同時に顕在化しているのが、他者に対する辛らつな意見だ。ネットニュース...
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ExcelVBAを使って、値...
-
TODAY()で設定したセルの日付...
-
任意フォルダから画像をすべて...
-
Excelで指定した日付から過去の...
-
セル色なしの行一括削除
-
i=cells(Rows.Count, 1)とi=cel...
-
DataGridViewのセルのItem設定...
-
【VBA】シート上の複数のチェッ...
-
特定のセルが空白だったら、そ...
-
Application.Matchで特定行の検索
-
連続する複数のセル値がすべて0...
-
DataGridViewで列、行、セルの選択
-
CountIf で","(カンマ)の数が...
-
【Excel VBA】指定行以降をクリ...
-
【VBA】指定したセルと同じ値で...
-
Excel vbaで特定の文字以外が入...
-
VBA実行後に元のセルに戻りたい
-
VBA ユーザーフォーム ボタンク...
-
VLOOKUP関数で別ファイルを指定...
-
EXCELで変数をペーストしたい
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ExcelVBAを使って、値...
-
特定のセルが空白だったら、そ...
-
Excelで指定した日付から過去の...
-
i=cells(Rows.Count, 1)とi=cel...
-
エクセルvbaで、別シートの最下...
-
任意フォルダから画像をすべて...
-
VBA実行後に元のセルに戻りたい
-
Application.Matchで特定行の検索
-
Excel vbaで特定の文字以外が入...
-
【Excel VBA】指定行以降をクリ...
-
”戻り値”が変化したときに、マ...
-
【Excel】指定したセルの名前で...
-
VBAでセル同士を比較して色付け
-
Excelのプルダウンで2列分の情...
-
VBAでセルをクリックする回...
-
Excel VBAで、 ヘッダーへのセ...
-
DataGridViewのセル編集完了後...
-
VBA初心者です。結合セルを保持...
-
【VBA】シート上の複数のチェッ...
-
ExcelのVBAで数字と文字列をマ...
おすすめ情報