excel關於資料重覆問題？（頭大！）

townboyed wrote:
剛才詢問Google...(恕刪)

Sub testdata() '隨機資料
    
    Dim i As Double, lastrow As Double, total As Double, ttt As Double
    
    Application.ScreenUpdating = False
        
    ttt = Timer
    lastrow = Application.RandBetween(601, 1201)
    
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> "總表" Then
            
            With Sheets(i)
                .Cells.Clear
                .Range("a1") = "編號"
            
                For j = 2 To lastrow
                
                    .Cells(j, 1) = Application.RandBetween(1, 300)
                    total = total + 1
                Next j
                
                .Cells(Application.RandBetween(2, lastrow), 1) = Chr(Application.RandBetween(65, 90)) & Application.RandBetween(1, 20)
                
            End With
            
        End If
    
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox total & "筆隨機資料" & vbNewLine & Timer - ttt, vbOKOnly, "report"
    
    
End Sub


Sub test() '找不重覆
    
    

    Dim d As Object, 編號, key, i As Double, j As Double, r As Double, lastrow As Double, ttt As Double


    Set d = CreateObject("scripting.dictionary")

    ttt = Timer

    For i = 1 To Sheets.Count
        If Sheets(i).Name <> "總表" Then
        
            If Sheets(i).Range("a1") = "" Then
                MsgBox "先按產生隨機資料", vbOKOnly, "error"
                Exit Sub
            End If
            
            lastrow = Sheets(i).Range("A1").CurrentRegion.Rows.Count
            編號 = Sheets(i).Range("A2:A" & lastrow)
                
            For j = 1 To UBound(編號)
                d(編號(j, 1)) = d(編號(j, 1)) + 1
            Next j
        
        End If
    Next i


    With Sheets("總表")
        .Cells.Clear
        .Range("a1:c1") = Array("所有編號(debug)", "重覆次數(debug)", "只出現過一次")
        .Range("a2").Resize(d.Count , 1) = Application.Transpose(d.keys)
        .Range("b2").Resize(d.Count , 1) = Application.Transpose(d.items)

        r = 1
        For Each key In d.keys
            If d(key) = 1 Then
                r = r + 1
                .Cells(r, 3) = key
            End If
        Next
    
        .Columns("C:C").HorizontalAlignment = xlCenter
        
    End With
    
    Set d = Nothing
    
    Debug.Print Timer - ttt
    MsgBox r-1 & "筆" & vbNewLine & Timer - ttt & "s", vbOKOnly, "report"

End Sub