Option Explicit
 
Public Sub CSV作成()
    Dim MFile As String     '商品.csv
    Dim SFile As String     '1.csv
    Dim mb As Workbook      '商品.csvのbook
    Dim ms As Worksheet     '商品.csvのSheet
    Dim sb As Workbook      '1.csvのbook
    Dim ss As Worksheet     '1.csvのSheet
    Dim tb As Workbook      '有り.csvのbook
    Dim ts As Worksheet     '有り.csvのSheet
    Dim mrow As Long            '商品.csv 行番号
    Dim srow As Long            '1.csv 行番号
    Dim trow As Long: trow = 2  '有り.csv 行番号
    Dim dicM As Object      '商品.csv   キー：商品コード　値：行番号
    Dim dicS As Object      '1.csv      キー：商品コード　値：行番号
    Dim key As Variant      'キー（商品コード）
    Dim BPath As String     'デスクトップパス
    Dim WSH As Variant
    'デスクトップのパスを取得
    Set WSH = CreateObject("WScript.Shell")
    BPath = WSH.SpecialFolders("Desktop") & "\"
 
    Set dicM = CreateObject("Scripting.Dictionary")    ' Dictionaryの定義
    Set dicS = CreateObject("Scripting.Dictionary")    ' Dictionaryの定義
 
    MFile = BPath & "商品.csv"
    SFile = BPath & "1.csv"
    '商品.csvをオープン
    Workbooks.OpenText Filename:=MFile, DataType:=xlDelimited, comma:=True, textqualifier:=xlTextQualifierNone
    Set mb = Workbooks.Item(Workbooks.count)
    Set ms = mb.Worksheets(1)
    '1.csvをオープン
    Workbooks.OpenText Filename:=SFile, DataType:=xlDelimited, comma:=True, textqualifier:=xlTextQualifierNone
    Set sb = Workbooks.Item(Workbooks.count)
    Set ss = sb.Worksheets(1)
    '有り.csv用bookをオープン
    Set tb = Workbooks.Add
    Set ts = tb.Worksheets(1)
    '商品.csvの商品コードを記憶
    For mrow = 2 To ms.Cells(Rows.count, 1).End(xlUp).Row
        key = ms.Cells(mrow, "A").Value
        dicM(key) = mrow
    Next
    '有り.csvへ見出しをコピー
    ts.Cells(1, "A").Resize(1, 3).Value = ss.Cells(1, "A").Resize(1, 3).Value
    '1.csvを処理する
    For srow = 2 To ss.Cells(Rows.count, 1).End(xlUp).Row
        key = ss.Cells(srow, "A").Value
        '1.csvの商品コードが商品.csvに存在し
        If dicM.exists(key) = True Then
            '1.csv内で最初に出現した商品コードの場合
            If dicS.exists(key) = False Then
                '有り.csvへコピーする
                ts.Cells(trow, "A").Resize(1, 3).Value = ss.Cells(srow, "A").Resize(1, 3).Value
                'この商品コードを記憶する（次回は対象外とする為）
                dicS(key) = srow
                '有り.csvの行番号に1加算
                trow = trow + 1
            End If
        End If
    Next
    '有り.csvを保存
    Application.DisplayAlerts = False
    tb.SaveAs BPath & "有り.csv", FileFormat:=xlCSV, CreateBackup:=False
    Application.DisplayAlerts = True
    'bookのクローズ
    tb.Close
    mb.Close
    sb.Close
    MsgBox ("完了")
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIENTVuS9nOaIkCgpCiAgICBEaW0gTUZpbGUgQXMgU3RyaW5nICAgICAn5ZWG5ZOBLmNzdgogICAgRGltIFNGaWxlIEFzIFN0cmluZyAgICAgJzEuY3N2CiAgICBEaW0gbWIgQXMgV29ya2Jvb2sgICAgICAn5ZWG5ZOBLmNzduOBrmJvb2sKICAgIERpbSBtcyBBcyBXb3Jrc2hlZXQgICAgICfllYblk4EuY3N244GuU2hlZXQKICAgIERpbSBzYiBBcyBXb3JrYm9vayAgICAgICcxLmNzduOBrmJvb2sKICAgIERpbSBzcyBBcyBXb3Jrc2hlZXQgICAgICcxLmNzduOBrlNoZWV0CiAgICBEaW0gdGIgQXMgV29ya2Jvb2sgICAgICAn5pyJ44KKLmNzduOBrmJvb2sKICAgIERpbSB0cyBBcyBXb3Jrc2hlZXQgICAgICfmnInjgoouY3N244GuU2hlZXQKICAgIERpbSBtcm93IEFzIExvbmcgICAgICAgICAgICAn5ZWG5ZOBLmNzdiDooYznlarlj7cKICAgIERpbSBzcm93IEFzIExvbmcgICAgICAgICAgICAnMS5jc3Yg6KGM55Wq5Y+3CiAgICBEaW0gdHJvdyBBcyBMb25nOiB0cm93ID0gMiAgJ+acieOCii5jc3Yg6KGM55Wq5Y+3CiAgICBEaW0gZGljTSBBcyBPYmplY3QgICAgICAn5ZWG5ZOBLmNzdiAgIOOCreODvO+8muWVhuWTgeOCs+ODvOODieOAgOWApO+8muihjOeVquWPtwogICAgRGltIGRpY1MgQXMgT2JqZWN0ICAgICAgJzEuY3N2ICAgICAg44Kt44O877ya5ZWG5ZOB44Kz44O844OJ44CA5YCk77ya6KGM55Wq5Y+3CiAgICBEaW0ga2V5IEFzIFZhcmlhbnQgICAgICAn44Kt44O877yI5ZWG5ZOB44Kz44O844OJ77yJCiAgICBEaW0gQlBhdGggQXMgU3RyaW5nICAgICAn44OH44K544Kv44OI44OD44OX44OR44K5CiAgICBEaW0gV1NIIEFzIFZhcmlhbnQKICAgICfjg4fjgrnjgq/jg4jjg4Pjg5fjga7jg5HjgrnjgpLlj5blvpcKICAgIFNldCBXU0ggPSBDcmVhdGVPYmplY3QoIldTY3JpcHQuU2hlbGwiKQogICAgQlBhdGggPSBXU0guU3BlY2lhbEZvbGRlcnMoIkRlc2t0b3AiKSAmICJcIgogICAgCiAgICBTZXQgZGljTSA9IENyZWF0ZU9iamVjdCgiU2NyaXB0aW5nLkRpY3Rpb25hcnkiKSAgICAnIERpY3Rpb25hcnnjga7lrprnvqkKICAgIFNldCBkaWNTID0gQ3JlYXRlT2JqZWN0KCJTY3JpcHRpbmcuRGljdGlvbmFyeSIpICAgICcgRGljdGlvbmFyeeOBruWumue+qQogICAgCiAgICBNRmlsZSA9IEJQYXRoICYgIuWVhuWTgS5jc3YiCiAgICBTRmlsZSA9IEJQYXRoICYgIjEuY3N2IgogICAgJ+WVhuWTgS5jc3bjgpLjgqrjg7zjg5fjg7MKICAgIFdvcmtib29rcy5PcGVuVGV4dCBGaWxlbmFtZTo9TUZpbGUsIERhdGFUeXBlOj14bERlbGltaXRlZCwgY29tbWE6PVRydWUsIHRleHRxdWFsaWZpZXI6PXhsVGV4dFF1YWxpZmllck5vbmUKICAgIFNldCBtYiA9IFdvcmtib29rcy5JdGVtKFdvcmtib29rcy5jb3VudCkKICAgIFNldCBtcyA9IG1iLldvcmtzaGVldHMoMSkKICAgICcxLmNzduOCkuOCquODvOODl+ODswogICAgV29ya2Jvb2tzLk9wZW5UZXh0IEZpbGVuYW1lOj1TRmlsZSwgRGF0YVR5cGU6PXhsRGVsaW1pdGVkLCBjb21tYTo9VHJ1ZSwgdGV4dHF1YWxpZmllcjo9eGxUZXh0UXVhbGlmaWVyTm9uZQogICAgU2V0IHNiID0gV29ya2Jvb2tzLkl0ZW0oV29ya2Jvb2tzLmNvdW50KQogICAgU2V0IHNzID0gc2IuV29ya3NoZWV0cygxKQogICAgJ+acieOCii5jc3bnlKhib29r44KS44Kq44O844OX44OzCiAgICBTZXQgdGIgPSBXb3JrYm9va3MuQWRkCiAgICBTZXQgdHMgPSB0Yi5Xb3Jrc2hlZXRzKDEpCiAgICAn5ZWG5ZOBLmNzduOBruWVhuWTgeOCs+ODvOODieOCkuiomOaGtgogICAgRm9yIG1yb3cgPSAyIFRvIG1zLkNlbGxzKFJvd3MuY291bnQsIDEpLkVuZCh4bFVwKS5Sb3cKICAgICAgICBrZXkgPSBtcy5DZWxscyhtcm93LCAiQSIpLlZhbHVlCiAgICAgICAgZGljTShrZXkpID0gbXJvdwogICAgTmV4dAogICAgJ+acieOCii5jc3bjgbjopovlh7rjgZfjgpLjgrPjg5Tjg7wKICAgIHRzLkNlbGxzKDEsICJBIikuUmVzaXplKDEsIDMpLlZhbHVlID0gc3MuQ2VsbHMoMSwgIkEiKS5SZXNpemUoMSwgMykuVmFsdWUKICAgICcxLmNzduOCkuWHpueQhuOBmeOCiwogICAgRm9yIHNyb3cgPSAyIFRvIHNzLkNlbGxzKFJvd3MuY291bnQsIDEpLkVuZCh4bFVwKS5Sb3cKICAgICAgICBrZXkgPSBzcy5DZWxscyhzcm93LCAiQSIpLlZhbHVlCiAgICAgICAgJzEuY3N244Gu5ZWG5ZOB44Kz44O844OJ44GM5ZWG5ZOBLmNzduOBq+WtmOWcqOOBlwogICAgICAgIElmIGRpY00uZXhpc3RzKGtleSkgPSBUcnVlIFRoZW4KICAgICAgICAgICAgJzEuY3N25YaF44Gn5pyA5Yid44Gr5Ye654++44GX44Gf5ZWG5ZOB44Kz44O844OJ44Gu5aC05ZCICiAgICAgICAgICAgIElmIGRpY1MuZXhpc3RzKGtleSkgPSBGYWxzZSBUaGVuCiAgICAgICAgICAgICAgICAn5pyJ44KKLmNzduOBuOOCs+ODlOODvOOBmeOCiwogICAgICAgICAgICAgICAgdHMuQ2VsbHModHJvdywgIkEiKS5SZXNpemUoMSwgMykuVmFsdWUgPSBzcy5DZWxscyhzcm93LCAiQSIpLlJlc2l6ZSgxLCAzKS5WYWx1ZQogICAgICAgICAgICAgICAgJ+OBk+OBruWVhuWTgeOCs+ODvOODieOCkuiomOaGtuOBmeOCi++8iOasoeWbnuOBr+WvvuixoeWkluOBqOOBmeOCi+eCuu+8iQogICAgICAgICAgICAgICAgZGljUyhrZXkpID0gc3JvdwogICAgICAgICAgICAgICAgJ+acieOCii5jc3bjga7ooYznlarlj7fjgasx5Yqg566XCiAgICAgICAgICAgICAgICB0cm93ID0gdHJvdyArIDEKICAgICAgICAgICAgRW5kIElmCiAgICAgICAgRW5kIElmCiAgICBOZXh0CiAgICAn5pyJ44KKLmNzduOCkuS/neWtmAogICAgQXBwbGljYXRpb24uRGlzcGxheUFsZXJ0cyA9IEZhbHNlCiAgICB0Yi5TYXZlQXMgQlBhdGggJiAi5pyJ44KKLmNzdiIsIEZpbGVGb3JtYXQ6PXhsQ1NWLCBDcmVhdGVCYWNrdXA6PUZhbHNlCiAgICBBcHBsaWNhdGlvbi5EaXNwbGF5QWxlcnRzID0gVHJ1ZQogICAgJ2Jvb2vjga7jgq/jg63jg7zjgroKICAgIHRiLkNsb3NlCiAgICBtYi5DbG9zZQogICAgc2IuQ2xvc2UKICAgIE1zZ0JveCAoIuWujOS6hiIpCkVuZCBTdWIK