VBAで一連番号ごとに顧客データーを入力シートに入力し、転記ボタンにより帳簿(台帳)に記録するようにコード作成中ですが、転記先が同じ行になって上書されてしまいます。一連番号の行に順次に転記できるようにしたいのすが、作成コードが解りません。コード次のとおりです。作表は添付しています。
Sub 転記2()
Dim sh3 As Worksheet
Dim sh1 As Worksheet
Dim maxrow As Long
Dim row As Long
Dim dicT As Object
Dim key As Variant
Set sh3 = Worksheets("台帳")
Set sh1 = Worksheets("入力シート")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh3.Cells(Rows.Count, "CF").End(xlUp).row
'小切手番号を記憶
For row = 7 To maxrow
key = sh3.Cells(row, "CF").Value
dicT(key) = row
Next
key = sh1.Cells(35, "M").Value
key = sh1.Cells(36, "M").Value
key = sh1.Cells(37, "M").Value
key = sh1.Cells(38, "M").Value
key = sh1.Cells(39, "M").Value
key = sh1.Cells(40, "M").Value
If dicT.exists(key) = False Then
MsgBox ("小切手番号=" & key & "は台帳にありません")
Exit Sub
End If
row = dicT(key)
sh3.Range("V7").Value = sh1.Range("M35").Value '小切手番号
sh3.Range("AG7").Value = sh1.Range("M36").Value '小切手番号
sh3.Range("AQ7").Value = sh1.Range("M37").Value '小切手番号
sh3.Range("BA7").Value = sh1.Range("M38").Value '小切手番号
sh3.Range("BK7").Value = sh1.Range("M39").Value '小切手番号
sh3.Range("BU7").Value = sh1.Range("M40").Value '小切手番号
MsgBox ("転記します")
End Sub
No.8ベストアンサー
- 回答日時:
No.7のお礼に対して。
基本的には質問文にある
sh3.Range("V7").Value = sh1.Range("M35").Value '小切手番号
sh3.Range("AG7").Value = sh1.Range("M36").Value '小切手番号
sh3.Range("AQ7").Value = sh1.Range("M37").Value '小切手番号
sh3.Range("BA7").Value = sh1.Range("M38").Value '小切手番号
sh3.Range("BK7").Value = sh1.Range("M39").Value '小切手番号
sh3.Range("BU7").Value = sh1.Range("M40").Value '小切手番号
このコードを基に考えてますが、No.5~7のどれでもないと言うのはあとは何を欲しているのでしょうか?と疑問です。
台帳シートのV4~CF最終行までって文字が読めないのですが、一体何が書かれているのか?
入力シートに入力したものって本来なら1行分なのでしょうけど、M35~M40のどれか1つに対してだけ実行させたいって事なのでしょうか?
もしそうなら質問文のコードを、
Sub 転記2()
Dim sh3 As Worksheet
Dim sh1 As Worksheet
Dim maxrow As Long
Dim row As Long
Dim dicT As Object
Dim key As Variant
Set sh3 = Worksheets("台帳")
Set sh1 = Worksheets("入力シート")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh3.Cells(Rows.Count, "CF").End(xlUp).row
'小切手番号を記憶
For row = 7 To maxrow
key = sh3.Cells(row, "CF").Value
dicT(key) = row
Next
key = sh1.Cells(35, "M").Value
If dicT.exists(key) = False Then
MsgBox ("小切手番号=" & key & "は台帳にありません")
Exit Sub
End If
row = dicT(key)
sh3.Range("V" & row).Value = sh1.Range("M35").Value '小切手番号
sh3.Range("AG" & row).Value = sh1.Range("M36").Value '小切手番号
sh3.Range("AQ" & row).Value = sh1.Range("M37").Value '小切手番号
sh3.Range("BA" & row).Value = sh1.Range("M38").Value '小切手番号
sh3.Range("BK" & row).Value = sh1.Range("M39").Value '小切手番号
sh3.Range("BU" & row).Value = sh1.Range("M40").Value '小切手番号
MsgBox ("転記します")
End Sub
となるように思われますけど?
No.5
- 回答日時:
No.2~4です。
何か思いっきり勘違いだったかも。
No.3とNo.4のコードはダメでしょうね。
GooUserラックさんの回答の方が正解に近いかも?
Sub 転記2()
Dim sh3 As Worksheet
Dim sh1 As Worksheet
Dim maxrow As Long
Dim row As Long
Dim dicT As Object
Dim key As Variant
Dim r1 As Range, st As String '★追加
Dim i As Integer, v As Variant '★追加
Set sh3 = Worksheets("台帳")
Set sh1 = Worksheets("入力シート")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh3.Cells(Rows.Count, "CF").End(xlUp).row
'小切手番号を記憶
For row = 7 To maxrow
key = sh3.Cells(row, "CF").Value
dicT(key) = row
Next
st = ""
v = Array("V", "AG", "AQ", "BA", "BK", "BU")
For Each r1 In sh1.Range("M35:M40")
key = r1.Value '★順次セルの値を変化させ代入する
If dicT.exists(key) = False Then
st = st & "小切手番号=" & key & "は台帳にありません" & vbCrLf '★最後に表示させる
'Exit Sub '★途中で抜けるのは違いますよね?"
Else
row = dicT(key)
For i = 0 To UBound(v)
sh3.Range(v(i) & row).Value = key '小切手番号
Next
End If
Next
MsgBox ("転記しました")
If st <> "" Then MsgBox (st) '★台帳にない小切手番号が存在してたら表示
End Sub
かな?
No.4
- 回答日時:
No.2です。
このコードは破棄してください。
修正版。
Sub 転記2()
Dim sh3 As Worksheet
Dim sh1 As Worksheet
Dim maxrow As Long
Dim row As Long
Dim dicT As Object
Dim key As Variant
Dim r1 As Range, st As String '★追加
Dim i As Integer, v As Variant '★追加
Set sh3 = Worksheets("台帳")
Set sh1 = Worksheets("入力シート")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh3.Cells(Rows.Count, "CF").End(xlUp).row
'小切手番号を記憶
For row = 7 To maxrow
key = sh3.Cells(row, "CF").Value
dicT(key) = row
Next
st = ""
i = 0
v = Array("V8", "AG8", "AQ8", "BA8", "BK8", "BU8")
For Each r1 In sh1.Range("M35:M40")
key = r1.Value '★順次セルの値を変化させ代入する
If dicT.exists(key) = False Then
st = st & "小切手番号=" & key & "は台帳にありません" & vbCrLf '★最後に表示させる
'Exit Sub '★途中で抜けるのは違いますよね?"
Else
row = dicT(key)
sh3.Range(v(i)).Value = r1.Value '小切手番号
End If
i = i + 1
Next
MsgBox ("転記しました")
If st <> "" Then MsgBox (st) '★台帳にない小切手番号が存在してたら表示
End Sub
転記する小切手番号がなかった場合、転記するセルは空白で宜しいのですよね?
No.2のコードですと空白にならず詰めてしまいますので違うかなと思いまして。
No.3
- 回答日時:
No.2です。
図が見づらいのはPC画面で見てみて何となくわかりました。
>V8~BU8に転記されない?
コードをよく見てみて下さい。
V7~BU7を指定してます。
変更をかけた際の修正漏れではないでしょうか?
未検証で申し訳ないですが、
Sub 転記2()
Dim sh3 As Worksheet
Dim sh1 As Worksheet
Dim maxrow As Long
Dim row As Long
Dim dicT As Object
Dim key As Variant
Dim r1 As Range, st As String '★追加
Dim i As Integer, v As Variant '★追加
Set sh3 = Worksheets("台帳")
Set sh1 = Worksheets("入力シート")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh3.Cells(Rows.Count, "CF").End(xlUp).row
'小切手番号を記憶
For row = 7 To maxrow
key = sh3.Cells(row, "CF").Value
dicT(key) = row
Next
st = ""
i = -1
v = Array("V8", "AG8", "AQ8", "BA8", "BK8", "BU8")
For Each r1 In sh1.Range("M35:M40")
key = r1.Value '★順次セルの値を変化させ代入する
If dicT.exists(key) = False Then
st = st & "小切手番号=" & key & "は台帳にありません" & vbCrLf '★最後に表示させる
'Exit Sub '★途中で抜けるのは違いますよね?"
Else
row = dicT(key)
i = i + 1
sh3.Range(v(i)).Value = r1.Value '小切手番号
End If
Next
If i > -1 Then MsgBox ("転記しました")
If st <> "" Then MsgBox (st & "以上。") '★台帳にない小切手番号が存在してたら表示
End Sub
このような感じでしょうかね?
No.2
- 回答日時:
スマホなので確認は出来ませんが。
key = sh1.Cells(35, "M").Value
key = sh1.Cells(36, "M").Value
key = sh1.Cells(37, "M").Value
key = sh1.Cells(38, "M").Value
key = sh1.Cells(39, "M").Value
key = sh1.Cells(40, "M").Value
って結局一番最後のM40の値がkeyに入るだけですよね?
なので書き出すためのループを作成しないとダメなのではないかな?
スマホなのでコードは書けませんけど。
No.1
- 回答日時:
図が良く見えないので自信はありませんが
sh3.Range("V7").Value = sh1.Range("M35").Value '小切手番号
sh3.Range("AG7").Value = sh1.Range("M36").Value '小切手番号
sh3.Range("AQ7").Value = sh1.Range("M37").Value '小切手番号
sh3.Range("BA7").Value = sh1.Range("M38").Value '小切手番号
sh3.Range("BK7").Value = sh1.Range("M39").Value '小切手番号
sh3.Range("BU7").Value = sh1.Range("M40").Value '小切手番号
は以下ではありませんか?
sh3.Cells(row,"V").Value = sh1.Range("M35").Value '小切手番号
sh3.Cells(row,"AG").Value = sh1.Range("M36").Value '小切手番号
sh3.Cells(row,"AQ").Value = sh1.Range("M37").Value '小切手番号
sh3.Cells(row,"BA").Value = sh1.Range("M38").Value '小切手番号
sh3.Cells(row,"BK").Value = sh1.Range("M39").Value '小切手番号
sh3.Cells(row,"BU").Value = sh1.Range("M40").Value '小切手番号
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) 2つ目のコンボボックスが動作しません。 3 2023/03/25 12:29
- Visual Basic(VBA) VBA 別ブックからの転記の高速化について VBA 別ブックからの転記の高速化についてご教授下さい。 19 2022/07/26 13:07
- Visual Basic(VBA) Excel VBA ユーザーフォーム1のコンボボックスに別ブックの値を反映させたいです。 6 2023/03/21 16:12
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) 特定の文字を含むシートだけマクロ処理をしたい 1 2023/05/22 01:43
- Visual Basic(VBA) マクロで最終行を取得したい 4 2023/05/28 12:14
- Visual Basic(VBA) 稀に1円合いません? Sheet1から金額と個数を貼り付ける下記コードで、金額を切り上げるコードを何 3 2022/09/05 15:11
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
シャープのアクオス sh-m25 を...
-
エクセルVBAで 2種のリストを...
-
Excel VBA インデックスの境...
-
Excel で行を指定回数だけコピ...
-
EXCELマクロで全シート対...
-
【VBA】UserForm1の中で使うワ...
-
VBAで条件が一致する行のデータ...
-
Excel VBAでシート内全体に非表...
-
VBAで複数シート選択
-
excelの差込印刷で可視セルだけ...
-
VBA 最終行取得からの繰り返し貼付
-
スマホ機種変更で旧機種のGoogl...
-
画面が真っ暗に・・・
-
携帯電話間のデータ移動の方法...
-
PC修理に出すのですが、個人情...
-
携帯修理出して戻ってきたら、L...
-
携帯会社が確認もなしにデータ...
-
LAVIE Direct DT PC-GD298ZZAL...
-
ドコモの電話帳バックアップに...
-
スマホにPCから音楽を入れたい...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBA 別シートの複数の...
-
Excel で行を指定回数だけコピ...
-
Excel VBA インデックスの境...
-
excelの差込印刷で可視セルだけ...
-
VBA:同じ文字列データの比...
-
VBA別シートの最終行の下行へ貼...
-
エクセル:VBAで月変わりで、自...
-
エクセルVBAで 2種のリストを...
-
歯抜けの時間を埋めて行の挿入
-
エクセルVBAで SendKeys "{TAB}"
-
VBAで条件が一致する行のデータ...
-
EXCELマクロで全シート対...
-
VBAの指示の内容 昨日こちらで...
-
Excel VBAでシート内全体に非表...
-
VBAで複数シート選択
-
Excelマクロ データが上書きさ...
-
Excel VBA 時刻でのD...
-
VBA 貼付先範囲(行)がいっぱ...
-
エクセルVBAでの日付順のデ...
-
【WORD差し込み印刷】複数レコ...
おすすめ情報
・GooUerラックさん 有り難う御座います。
コードの数字を消して実行してみましたが、「小切手番号=台帳にありません」とメッセージでました。
・めぐみさん 有り難う御座います。
入力シートに小切手NOを全て入れない「小切手番号=台帳にありません」とメッセージでます。すべてに入力すると7行目のみ転記されます。ループを教えて頂ければ助かります。
めぐみんさん 有り難う御座います。
ご教授いただいたコードはNO5のとおり修正し、転記実行したところ「転記しました」とメッセージされました。一連番号2で実行したところ2行目の指定セルに転記され、M36~M38を空白にすると「小切手番号が台帳にありません」とメッセージされ、指定セルは空白になり、うまく実行できました。
しかし、台帳のM8~BU13セルの全てに入力シートのM35~M40の小切手Noが1行ごとに同じNOで転記されます。一連番号ごとに転記できるように、手数ですが教えていただきますようお願いします。
休日でお休みにところすみません。