2つブック 条件転記と分岐の方法

質問

以前に２つのブックを条件で転記させるマクロのアドバイスを頂き
活用させていただいておりましたが
票の形式が変わってしまって、新規,変更,廃止という文言がなくなって日付だけで
判別する形式になってしまって現在、修正しております。

大変恐縮ですが、CASEで分岐させるときの書き方を色々と調べておりますが
分岐させる条件の書き方を色々とやってみましたが上手く動きませんでした・・・
ご教授願えないでしょうか？

下記に構成と概要と
以前にアドバイスを頂いたコードを記述させて頂きます。

IDデータ表.xls
　　 A列　　　 　　　　 B列　　　
1　　ID番号　　　　 　日付
2　 110001241　　　 10/4
3　 120000065　　　 10/5
4　 190000036　　　 10/6
5 190000088　　　 取消

ID管理票.xls

110001241 ,9/1
120000065 9/9
190000036 9/9
190000088 11/11

IDの場所はバラバラですが日付は必ずIDの横３つのどれかに記述されています。
以前にアドバイスを頂いたマクロは　新規,廃止,変更で
offsetでIDの横３つの場所を指定して日付を記述する形式でしたが
新規,廃止,変更の文言がデータから、なくなってしまったので

IDデータ表.xlsとID管理票.xlsのIDが一致して
尚且つそのIDの横３つのセルに日付が入ってるものを上書き
空白のセルは無視する

IDデータ表のB列に取消と入っていたら
ID管理票と合致したIDとその横３つの日付をクリアする。

Sub 転記()
Dim w0 As Worksheet, w1 As Worksheet
Dim h As Range, Target As Range

Set w0 = Workbooks("IDデータ表.xls").Worksheets("大元")
Set w1 = Workbooks("ID管理票.xls").Worksheets("管理")

For Each h In w0.Range("A2:A" & w0.Range("A65536").End(xlUp).Row)
Set Target = w1.Cells.Find(what:=h.Value, LookIn:=xlValues, lookat:=xlWhole)

If Not Target Is Nothing Then
Select Case h.Offset(0, 1).Value
Case "新規"
Target.Offset(0, 1) = h.Offset(0, 2).Value
Case "変更"
Target.Offset(0, 2) = h.Offset(0, 2).Value
Case "廃止"
Target.Offset(0, 3) = h.Offset(0, 2).Value
Case Else
'do nothing
End Select
End If
Next
End Sub

CASEで分岐させれば可能だと助言を頂きましたが如何せん
上手く記述できないのでご教授願えないでしょうか？
申し訳ありませんがよろしくお願いいたします

回答No.3

tom04 · ベストアンサー

続けてお邪魔します。

＞IDデータ表の日付から→ID管理票のIDの横に記述にしたいのですが・・・
「上書き」とはそういうコトだったのですね。

↓のコードに変更してみてください。
尚、「ID管理票」Sheetの3つのセルデータは消去していますので、
残したい場合は適宜コードを訂正してください。

Sub 修正()
Dim w0 As Worksheet, w1 As Worksheet
Dim i As Long, c As Range

Set w0 = Workbooks("IDデータ表.xls").Worksheets("大元")
Set w1 = Workbooks("ID管理票.xls").Worksheets("管理")
For i = 2 To w0.Cells(Rows.Count, "A").End(xlUp).Row
Set c = w1.Cells.Find(what:=w0.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
'▼ここから訂正
With c.Offset(, 1)
.Resize(, 3).ClearContents '←IDの3つ右隣りのセルを消去★
.Value = w0.Cells(i, "B")
.NumberFormatLocal = "m/d" '←セルの表示形式は好みで★
End With
'▲ここまで
Else
c.Resize(, 4).ClearContents
End If
End If
Next i
End Sub

今度はどうでしょうか？m(_ _)m

お礼

tom04様

修正して頂いたコードで無事動作できました。
本当にありがとうございます！！

マクロについては本で基礎的な事を覚え初めて
FINDやIF～やloopなど勉強中です。

マクロの奥深さを知ると同時にまだまだ勉強することが多いと思っています。

コードの記述とご対応ありがとうございました。

回答No.2

tom04

No.1です。

投稿後もう一度コードを見直すと間違いがありました。

＞Set c = w1.Cells.Find(what:=Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
の行を
＞Set c = w1.Cells.Find(what:=w0.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
に変更してください。

Sheetを指定していなかったので
エラーになるかもしれません。

検証せずに投稿してごめんなさいね。m(_ _)m

お礼

tom04様
色々とお手数かけて申し訳ありません
ありがとうございます。

再度、修正していただいたコードを試してみましたが
エラーやデバック等はありませんでしたが

ID管理票の３つのどれかのセルの日付→IDデータ表に転記されております。

IDデータ表の日付から→ID管理票のIDの横に記述にしたいのですが

申し訳ありませんが確認してもらってもよろしいでしょうか？

下記に修正後のコードを記述します。
何度もお手数かけて恐縮です。
宜しくお願いいたします

Sub 修正()
Dim w0 As Worksheet, w1 As Worksheet
Dim i As Long, c As Range

Set w0 = Workbooks("IDデータ表.xls").Worksheets("大元")
Set w1 = Workbooks("ID管理票.xls").Worksheets("管理")
For i = 2 To w0.Cells(Rows.Count, "A").End(xlUp).Row
Set c = w1.Cells.Find(what:=w0.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
If w0.Cells(i, "B") <> "取消" Then
w0.Cells(i, "B") = WorksheetFunction.Max(c.Offset(, 1).Resize(, 3))
Else
c.Resize(, 4).ClearContents
End If
End If
Next i
End Sub

回答No.1

tom04

こんばんは！

＞日付は必ずIDの横３つのどれかに記述されています。
日付は1つのセルだけに入っているとすると・・・

Sub Sample1()
Dim w0 As Worksheet, w1 As Worksheet
Dim i As Long, c As Range

Set w0 = Workbooks("IDデータ表.xls").Worksheets("大元")
Set w1 = Workbooks("ID管理票.xls").Worksheets("管理")
For i = 2 To w0.Cells(Rows.Count, "A").End(xlUp).Row
Set c = w1.Cells.Find(what:=Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
If w0.Cells(i, "B") <> "取消" Then
w0.Cells(i, "B") = WorksheetFunction.Max(c.Offset(, 1).Resize(, 3))
Else
c.Resize(, 4).ClearContents
End If
End If
Next i
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

tom04様

早速のご回答ありがとうございます！！

頂いたコードを試してみたのですが
IDデータ表の取消と書かれた部分はID管理票からクリアになりました。
ありがとうございます。

ただ、コードを書いていただいて申し訳ありませんが
日付転記が　ID番号が合致したもので
IDデータ表の日付から→ID管理票のIDの横に記述ですが

頂いたコードを試してみたところ
ID管理票の３つのどれかのセルの日付→IDデータ表に転記されております。

回答頂いて申し訳ありませんが
IDデータ表の日付から→ID管理票のIDの横に記述にしたいのですが
この場合、コードのどの部分を変えれば宜しいのでしょうか？

お答えいた中、恐縮ですが
ご教授願います。

構成や画像について不明点があれば補足させて頂きます。
宜しくお願いいたします