■

http://q.hatena.ne.jp/1232766401
のb1.xlsがランダムの場合の質問の修正です。

Sub Macro1()
    Dim lastRow As Long
    Dim i As Long
    Dim wb As Worksheet
    Dim wc As Worksheet
    Dim r1 As Range
    Dim r2 As Range
    
    Set wb = Workbooks("b1.xls").Worksheets(1)
    Set wc = Workbooks("c1.xls").Worksheets(1)
    
    lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    With Sheet2
        For i = 1 To lastRow
            .Range("A" & i).Value = Sheet1.Range("A" & i).Value
            Set r1 = wb.Range("A:A").Find(Sheet1.Range("A" & i).Value)
            If Not r1 Is Nothing Then
                If r1.Offset(0, 1).Value <> "" Then
                    .Range("B" & i).Value = "-1"
                Else
                    .Range("B" & i).Value = "0"
                End If
            End If
            Set r1 = Nothing
            .Range("C" & i).Value = Sheet1.Range("B" & i).Value
            If Sheet1.Range("C" & i).Value <> "" Then
                .Range("D" & i).Value = Mid(Sheet1.Range("C" & i).Value, _
                    InStrRev(Sheet1.Range("C" & i).Value, "/") + 1)
                .Range("E" & i).Value = Mid(Sheet1.Range("D" & i).Value, _
                    InStrRev(Sheet1.Range("D" & i).Value, "/") + 1)
            Else
                If Sheet1.Range("D" & i).Value <> "" Then
                    .Range("D" & i).Value = Mid(Sheet1.Range("D" & i).Value, _
                        InStrRev(Sheet1.Range("D" & i).Value, "/") + 1)
                End If
            End If
            Set r2 = wc.Range("A:A").Find(Sheet1.Range("A" & i).Value)
            If Not r2 Is Nothing Then
                .Range("F" & i).Value = r2.Offset(0, 1).Value
            End If
            Set r2 = Nothing
        Next i
    End With
    
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\a1.csv", _
        FileFormat:=xlCSV, CreateBackup:=False

End Sub