Excel VBA で別ファイルの値と一致したらその行の値を設定する

質問

Excel VBAについてご質問します。

やりたいこととしては、別のファイル(refer.xls)の「A1」に記載されている値と、マクロを実行しているファイル(action.xls)の「C1」に記載されている値が"一文字でも一致している場合"、action.xlsの「D1」から右方向に、refer.xlsの1行目を全てコピペする、ということをやりたいです。

どのようにすればできるでしょうか？
プログラミング内容もあわせて教えていただけると助かります。

よろしくお願いします。

回答No.1

imogasi · ベストアンサー

＞プログラミング内容もあわせて教えていただけると助かります
これも丸投げの質問で、回答者にコードを書いてくれということで、規約違反では。
この課題は初心者には、易しくないと思う。参考までに挙げておくが、質問者にはコピペしか出来ないだろう。もっと勉強してからの課題。
ーー
どういうことのコード作成のスキルが要求されるか、解決が必要か、一歩一歩勉強しないと。
＞別のファイル(refer.xls)の「A1」に記載されている値と
別ファイルを開くコードは
Sub test01()
Dim wb As Workbook
Set wb = Workbooks.Open("C:\Documents and Settings\XXXX\デスクトップ\yyyy.xls")
x = wb.Worksheets("検索表B").Range("A1")
MsgBox x
wb.Close
Set wb = Nothing
End Sub
値は.Range("A1")でとれる。
＞refer.xlsの1行目を全て

Sub test01()
Dim wb As Workbook
Set wb = Workbooks.Open("C:\Documents and Settings\OTO\デスクトップ\01化B.xls")
x = wb.Worksheets("検索表B").Range("B1")
MsgBox x
'----第１行をコピーする用意
Set Z = wb.Worksheets("検索表B").Range("A1:J1")
wb.Worksheets("検索表B").Activate
Z.Copy Range("A10") 'テストでやってみるだけ
'-----
wb.Close
Set wb = Nothing
End Sub
ーー
＞action.xls)の「C1」に記載されている値
Sub test02()
y = ActiveWorkbook.Worksheets("Sheet1").Range("C1")
MsgBox y
End Sub
ーーー
＞一文字でも一致している場合
上述のXとYが比較対照
よいアルゴリズムもあると思うが、泥臭く
Sub test03()
x = "朝日はすばらしい"
y = "朝のコーヒーを飲む"
For i = 1 To Len(x)
p = InStr(y, Mid(x, i, 1))
If p <> 0 Then
MsgBox "同文字あり " & Mid(x, i, 1)
Exit Sub
End If
Next i
MsgBox "同文字なし"
End Sub
ーーー
＞action.xlsの「D1」から右方向に
上記の　Z.Copy Range("A10")
のDestinationを　D1にする。
＝＝＝＝＝
総合して
Sub test04()
Dim wb As Workbook
Dim wb0 As Workbook
Set wb0 = ActiveWorkbook
Set wb = Workbooks.Open("C:\Documents and Settings\OTO\デスクトップ\01化B.xls")
x = wb.Worksheets("検索表B").Range("B1")
MsgBox x
'----第１行をコピーする用意
Set Z = wb.Worksheets("検索表B").Range("A1:J1") 'ここではJ列までに限定
wb.Worksheets("検索表B").Activate
'-----
y = wb0.Worksheets("Sheet1").Range("C1")
MsgBox y
For i = 1 To Len(x)
p = InStr(y, Mid(x, i, 1))
If p <> 0 Then
MsgBox "同文字あり " & Mid(x, i, 1)
GoTo p1
End If
Next i
MsgBox "同文字なし"
Exit Sub
'---
p1:
Z.Copy wb0.Worksheets("Sheet1").Range("D1")
'---
wb.Close
Set wb = Nothing
End Sub
簡単な例でテスト済み。

お礼

できました！ご丁寧な回答ありがとうございました。