エクセルVBAの転記処理について

質問

２つのエクセルのブックがあり、
ブックAの[シート１]には、
A列　　　　B列　　　　　C列　　　　D列　　E列
コード　　　社名　　　　品名　　　　注文　　合計
12345　　グルメ社　　カレー　　400　　800
78910　　AA社　　　　豆　　　　 100　　250
12345　　グルメ社　　カレー　　400　　800
44123　　ラック社　　にんじん　　350　　400

のように、過去の注文データが1万件近くならんでおります。
ブックBの[現在]シートには、同じ列に同じ項目が並んでいるのですが、
A列　　　　B列　　　　　C列　　　　D列　　E列
コード　　　社名　　　　品名　　　　注文　　合計
12345　　グルメ社　　カレー　　400　　800
89123　　　　　　　　　　　　　　 100　　250
55158　　　　　　　　　　　　　　　　　　　　800
44123　　ラック社　　にんじん　　350　　400

のように、コード以外空欄というセルがあり、それが4千件あります。
ブックBにてB列が空欄の場合、ブックAのB・C・D列の値を転記する方法がわからず
困っております。
Sub ああ()
Dim lRow As Long
Dim i As Long
Dim エラーコード(25000)
Workbooks.Open Filename:=("C:\Documents and Settings\PC01\デスクトップ\bookA.xls")

Workbooks("C:\Documents and Settings\PC01\デスクトップ\bookA").Activate
Sheets("sheet1").Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row

x = ""
cnt = 0

For i = 4 To lRow

Workbooks("C:\Documents and Settings\PC01\デスクトップ\bookA").Activate
Sheets("sheet1").Select

If Cells(i, 2).Value = "" Then
JAN = Cells(i, 1)

Windows("book2.xls").Activate

Sheets("現在").Select

商品datarec = Cells(Rows.Count, 1).End(xlUp).Row

x = ""

Set 範囲 = Range(Cells(2, 1), Cells(商品datarec, 1))

検索 = JAN

On Error Resume Next

x = Application.WorksheetFunction.match(検索, 範囲, 0)

On Error GoTo 0

If x = "" Then

cnt = cnt + 1

エラーコード(cnt) = JAN

Else

Windows("book2.xls").Activate
Sheets("現在").Select

メーカー名 = Cells(x + 1, 5).Value
品名 = Cells(x + 1, 6).Value

Workbooks("C:\Documents and Settings\PC01\デスクトップ\bookA").Activate
Sheets("sheet1").Select

Cells(i, 2) = 社名
Cells(i, 3) = 品名

End If

End If

Next i

If cnt <> 0 Then

MsgBox "リストにない商品が" + Str(cnt) + "件ありました。" + vbCrLf

End If

End Sub
というプログラムを組みました。宣言は強制させておりません。
途中で混乱してきたためおかしなコードになっております。
すみませんが、お願い致します。

回答No.2

hallo-2007 · ベストアンサー

アドバイスですが、
１、一度にすべてのプログラム書きまくらずに分けてみましょう。
　ここでは、ブックAのシート１をブックBのSheet2に貼り付けています。
　最初にこれを実行しておいて方が、いちいちブックの変更がなくて楽です。
　必要であれば
Sub データの移動()
　Workbooks.Open Filename:=("C:\Documents and Settings\PC01\デスクトップ\bookA.xls")
　ThisWorkbook.Sheets("Sheet2")=Sheets("sheet1")
activeworkbook.Close
End Sub

を別途実行するボタンでも作ってください。

２、空白のセルの探して置き換えですので
　For Each~UsedRnge ですべてのセルをチェックさせます。
３、空白だった場合の処理を、サブルーチンで処理（コードを分けて書きます）
４、検索にはワークシート関数より　Findを使った方がエラーが発生せず楽です。

以上の考え方で
Dim 置換 As String

Sub ボタン1_Click()
Dim MyRng As Range
For Each MyRng In Sheets("Sheet1").UsedRange
If MyRng.Value = "" Then
列 = MyRng.Column
コード = Range("A" & MyRng.Row).Value

Call 検索(コード, 列)
MyRng.Value = 置換
End If
Next
End Sub

Sub 検索(コード, 列)
Set c = Sheets("Sheet2").Columns("A:A").Find(What:=コード, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
置換 = c.Offset(0, 列 - 1).Value
End If
End Sub

といった風にもできます。

お礼

ありがとうございました。
おかげさまでプログラムができました。1度に書こうとするのは昔、学生時にも指摘されました。もっと精進しますです。

回答No.1

bin-chan

> ブックBにてB列が空欄の場合、ブックAのB・C・D列の値を転記する方法がわからず
転記のルールは？
コードを提示するよりも、先になさりたいことを明確にしてください。

「ブックＡ・ブックＢともに、列Ａの値がそれぞれの中で重複しない」なら、
列Ａの値でVlookupで関連付け。

一度に更新しようとしないで、ブックＢ内に新たな列を設けブックＡを反映する。
結果を反映できたことを確認してから、ブックＢを編集し完成させればよさそう。

「ブックＡ・ブックＢともに、列Ａの値がそれぞれの中で重複する」なら別な案が必要。

補足

すみません。ブックBには上記のような虫食い状態の行と、
ちゃんと全セルが埋まっている行があります。転記ルールとしまして、ブックBの空欄になっている箇所のみ、ブックAから転記をしたいです。ちゃんと入力されている行も連続していくつかあるため、フィルタやVlookupでは手入力より多少ましという状態です。列Aは両ブック共、お客様コードのため同じコードで別の会社が載ってくることはありません。