ここから本文です

下記のことをするVBAのコードがお分かりの方いますでしょうか? 1.a列に番号、e列...

mon********さん

2018/1/2018:53:24

下記のことをするVBAのコードがお分かりの方いますでしょうか?
1.a列に番号、e列にお客さま名、o列に商品が入ったファイルaがあります。ファイル名は固定ではないです。毎月変更
2.ファイルb

が存在します。こちらは上記と入力内容は同じなのですが、順番が行も、列もバラバラです。
a列に番号ですが、b列に名前、cに商品名です。行もバラバラです。こちらはお客さま名順です。
3.上記2つのファイルの、ファイルaのa列.e列、o列の組み合わせと、ファイルbのa列.b列、c列の組み合わせが一致するかどうか?不一致ならどちらかを直す必要があり、抽出したいと考えてます。
今の考えとしては、1つのフォルダに2つのファイルを入れて、フォルダ内に置かれたファイルを全て開き、新規ブックを立ち上げ、
片方をシート1.片方をシート2にはりつけて
ファイルaのa列.e列、o列の組み合わせと、ファイルbのa列.b列、c列の組み合わせが一致するかどうか?をシート3を作り、不一致をあぶり出すとしたいです。ファイル名が固定ではないので、1つのフォルダに入れて行う予定です。どなたかお助けください。

この質問は、活躍中のチエリアン・専門家に回答をリクエストしました。

閲覧数:
78
回答数:
1
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

hon********さん

2018/1/2413:27:35

Sub シートコピペ()
Dim OpenFileName As String, FileName As String, Path As String
Dim wb1, wb2 As Workbook
Dim ws1, ws2 As Worksheet
OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
If OpenFileName <> "False" Then
FileName = Dir(OpenFileName)
Path = Replace(OpenFileName, FileName, "")
Else
MsgBox "キャンセルされました"
End If
Set wb1 = Application.Workbooks.Open(FileName:=FileName)
Set ws1 = wb1.Worksheets("Sheet1")
ActiveSheet.Copy _
Before:=Workbooks("Book5.xlsm").Sheets(1)
wb1.Close SaveChanges:=False
Set ws1 = Nothing
Set wb1 = Nothing
Set wb2 = Application.Workbooks.Open(FileName:="Book3.xls")
Set ws2 = wb2.Worksheets("Sheet1")
ActiveSheet.Copy _
Before:=Workbooks("Book5.xlsm").Sheets(2)
wb2.Close SaveChanges:=False
Set ws2 = Nothing
Set wb2 = Nothing
Sheets("Sheet1 (2)").Name = "Sheet2"
End Sub

Sub 比較()

Dim i, j, MaxRow1, MaxRow2 As Long
MaxRow1 = Cells(Rows.Count, 1).End(xlUp).Row
MaxRow2 = Cells(Rows.Count, 5).End(xlUp).Row
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")

ws1.Activate
ws1.Columns("A").Copy
ws3.Columns("A").PasteSpecial
ws1.Columns("E").Copy
ws3.Columns("B").PasteSpecial
ws1.Columns("O").Copy
ws3.Columns("C").PasteSpecial

ws2.Activate
ws2.Columns("A").Copy
ws3.Columns("E").PasteSpecial
ws2.Columns("B").Copy
ws3.Columns("F").PasteSpecial
ws2.Columns("C").Copy
ws3.Columns("G").PasteSpecial
ws3.Activate


For i = 1 To MaxRow1
For j = 1 To MaxRow2
If Cells(i, 1).Value = Cells(j, 5).Value And Cells(i, 2).Value = Cells(j, 6).Value And Cells(i, 3).Value = Cells(j, 7).Value Then
MsgBox "同じです"
Else
' MsgBox "違います"
End If
Next j
Next i

End Sub
検索部分は時間があったら・・・・

この質問は投票によってベストアンサーに選ばれました!

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる