Sub tt()
     Dim i As Integer
     For i = 2 To ActiveSheet.UsedRange.Rows.Count
      If Sheets(1).Cells(i, 6) <> "" Then
         Dim j As Integer
         For j = 2 To 153
             If Sheets(1).Cells(i, 6) = Sheets(2).Cells(j, 1) Then
                If Sheets(1).Cells(i, 7) = Sheets(2
 
).Cells(j, 2) Then
                   Sheets(1).Cells(i, 6) = ""
                   Sheets(1).Cells(i, 7) = ""
                                   Sheets(1).Cells(i, 9) = Sheets(2).Cells(j, 1)
                Sheets(1).Cells(i, 10) = Sheets(2).Cells(j, 2)
                Sheets(2).Cells(j, 3) = "Find"
 

             Else
                Sheets(1).Cells(i, 9) = Sheets(2).Cells(j, 1)
                Sheets(1).Cells(i, 10) = Sheets(2).Cells(j, 2)
                Sheets(2).Cells(j, 3) = "Find"
                End If
             End If 
         Next j
      End If
     Next i
End Sub

慎用

Sub tt()
     
 
Dim i As Integer
     For i = 2 To ActiveSheet.UsedRange.Rows.Count
      If Cells(i, 6) <> "" Then
         Dim n As Integer
         For n = 0 To 15
             If Cells(i, 6) <> Cells(i - 1, 6) And Cells(i, 6) = Cells(i + n, 6) Then
                If Cells(i, 10) <> "" Then
                   Cells(i, 10) = Cells(i, 10) & "/" & Cells(i + n, 7)
                End If
                If Cells(i, 10) = "" Then
                   Cells(i, 10) = Cells(i + n, 7)
                End If
               
             End If
         Next n
      End If
     Next i
End Sub

將舉證資訊表，匯出為EXCEL表，6列為標識碼，7列為舉證號。先以標識碼排序，然後執行，在10列產生新的舉證號，最後排序。