tatsumaru77様 昨日回答して頂いたものです。 すみませんが、昨日の質問で1つ補足があります

tatsumaru77様
昨日回答して頂いたものです。
すみませんが、昨日の質問で1つ補足があります。エクセルに回答納期を転記させて再度転記した場合に、回答納期が入力されている場合にはそのまま日付けが残るようにできないでしょうか？
簡単に言うと回答納期が入力されている場合には、なにも処理しないということです。
以下、昨日の質問です。
可能であれば教えて頂きたいです。
よろしくお願いします。

VBAについてです。
画像右側のCVSファイルのM列の回答納期を、左側ExcelファイルのK列に転記させたいです。
条件があり、エクセルファイル側のJ列の注文番号とCSVファイルのD列の注文番号がマッチした場合にのみ転記させたいです。
マクロの起動方法ですが、Excelファイルにマクロ起動ボタンをつくり、指定のCVSファイルを選択後転記させるという感じです。
現在は、ファイルを見比べながら手打ちで入力しています。
時間がかかるのと、入力ミスが多発するので、どなたか知恵を貸して頂きたいです。
よろしくお願いします。

No.1 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/05/15 15:28

修正しました。

前回のは破棄してください。

Option Explicit
Public Sub 回答納期転記()
Dim myFile As Variant
Dim ans As Integer
Dim dicT As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim ms As Worksheet
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim key As String
Set ms = Worksheets("データリスト")
myFile = Application.GetOpenFilename("CSVファイル(*.csv),*.csv")
If myFile = False Then Exit Sub
Set wb = Workbooks.Open(myFile)
ans = MsgBox(myFile & "を読み込みました。" & vbLf & "このファイルを処理しますか", vbOKCancel)
If ans <> vbOK Then Exit Sub
Set ws = wb.Worksheets(1)
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
maxrow1 = ws.Cells(Rows.count, "D").End(xlUp).Row 'D列の最大行取得
maxrow2 = ms.Cells(Rows.count, "J").End(xlUp).Row 'J列の最大行取得
For row1 = 2 To maxrow1
key = ws.Cells(row1, "D").Value
dicT(key) = ws.Cells(row1, "M").Value
Next
For row2 = 2 To maxrow2
If ms.Cells(row2, "K").Value = "" Then
key = ms.Cells(row2, "J").Value
If key <> "" Then
If dicT.exists(key) = True Then
ms.Cells(row2, "K").Value = dicT(key)
Else
ms.Cells(row2, "K").Value = ""
End If
End If
End If
Next
wb.Close
MsgBox ("完了")
End Sub

この回答へのお礼

ありがとうございます。
本当に感謝します。

お礼日時：2022/05/15 19:54