提取重复的代码 Sub bb() Dim RowEnd As Long, Dic, JGArr() RowEnd = Range("A1048576").End(xlUp).Row Allarr = Range("A1:A" & RowEnd).Value x = 1 Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(Allarr) Dic(Allarr(i, 1)) = Dic(Allarr(i, 1)) + 1 Next For Each d In Dic.keys If Dic(d) > 1 Then n = n + 1 ReDim Preserve JGArr(1 To n) JGArr(n) = d End If If n > 1 Then If n Mod 10000 = 0 Then Sheet2.Range("A" & x).Resize(10000, 1) = WorksheetFunction.Transpose(JGArr) x = x + 10000 Erase JGArr n = 0 End If End If Next If n = 0 Then Exit Sub Sheet2.Range("A" & x).Resize(10000, 1) = WorksheetFunction.Transpose(JGArr) End Sub 去除重复的代码 Sub bbb() Dim RowEnd As Long, Dic, JGArr() RowEnd = Range("A1048576").End(xlUp).Row Allarr = Range("A1:A" & RowEnd).Value Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(Allarr) Dic(Allarr(i, 1)) = Dic(Allarr(i, 1)) + 1 Next Sheet2.Range("A1").Resize(Dic.count, 1) = WorksheetFunction.Transpose(dic.keys) End Sub
