「みんな教えて! 選手権!!」開催のお知らせ

データ入力シートから別シートに一連番号ごと記録するコードを教えて下さい。

解決済

  • 質問者：sanshaintosi
  • 質問日時：
  • 回答数：8件

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

「データ入力シートから別シートに一連番号ご」の質問画像

質問者からの補足コメント

  • ・GooUerラックさん　有り難う御座います。
    　コードの数字を消して実行してみましたが、「小切手番号＝台帳にありません」とメッセージでました。
    ・めぐみさん　有り難う御座います。
    　入力シートに小切手NOを全て入れない「小切手番号＝台帳にありません」とメッセージでます。すべてに入力すると7行目のみ転記されます。ループを教えて頂ければ助かります。

      補足日時：2020/01/12 06:37
    通報する

  • めぐみんさん　有り難う御座います。
    ご教授いただいたコードはNO5のとおり修正し、転記実行したところ「転記しました」とメッセージされました。一連番号２で実行したところ２行目の指定セルに転記され、M36～M38を空白にすると「小切手番号が台帳にありません」とメッセージされ、指定セルは空白になり、うまく実行できました。
    しかし、台帳のM8～BU13セルの全てに入力シートのM35～M40の小切手Noが１行ごとに同じNOで転記されます。一連番号ごとに転記できるように、手数ですが教えていただきますようお願いします。
    休日でお休みにところすみません。

      補足日時：2020/01/12 15:44
    通報する
通報する

この質問への回答は締め切られました。

質問の本文を隠す

A 回答 (8件)

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のどれでもないと言うのはあとは何を欲しているのでしょうか？と疑問です。
台帳シートのＶ４～ＣＦ最終行までって文字が読めないのですが、一体何が書かれているのか？
入力シートに入力したものって本来なら１行分なのでしょうけど、M35~M40のどれか１つに対してだけ実行させたいって事なのでしょうか？
もしそうなら質問文のコードを、

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

となるように思われますけど？
    • good
    • 0
    • 件
通報する
この回答へのお礼

うまく転記できました。長時間に渡りご教授いただきいただき、大変有り難う御座いました。

通報する
お礼日時：2020/01/12 21:28

No.7

No.6です。


またミスってたようですね。

No.6の以下の修正を。

sh3.Range(v(i) & row).Value = sh1.Range("M35").Offset(i).Value '小切手番号
↓
sh3.Range(v(i) & row).Value = r1.Value '小切手番号

おねがいします。
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難う御座います。修正し、実行しましたら、小切手番号がV,AG,AQ,BA,BK,BUの列ごとにに表示されました。説明が解りにくて申し訳ございません。

通報する
お礼日時：2020/01/12 19:39

No.6

No.5 です。



またミス。

＞sh3.Range(v(i) & row).Value = key '小切手番号

を

sh3.Range(v(i) & row).Value = sh1.Range("M35").Offset(i).Value '小切手番号

で。
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難う御座います。コードを修正し転記してみました。転記はうまくいきました。まだ、解らない所があります。補足で説明しましたので、よろしくお願い致します。

通報する
お礼日時：2020/01/12 19:01

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

かな？
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難う御座います。このコードで実行してみます。

通報する
お礼日時：2020/01/12 18:58

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のコードですと空白にならず詰めてしまいますので違うかなと思いまして。
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難う御座います。このコードで修正しています。

通報する
お礼日時：2020/01/12 18:56

No.3

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 = -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

このような感じでしょうかね？
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難う御座います。

通報する
お礼日時：2020/01/12 18:55

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に入るだけですよね？
なので書き出すためのループを作成しないとダメなのではないかな？

スマホなのでコードは書けませんけど。
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難う御座います。

通報する
お礼日時：2020/01/12 18:54

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 '小切手番号
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難う御座います。遅くにすみません。転記しませんでした。

通報する
お礼日時：2020/01/12 18:54

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

Q質問する（無料）

関連するカテゴリからQ&Aを探す

ページトップページトップ

おすすめ情報

Q質問する（無料）

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

おすすめ情報