我正在嘗試洗掉重復項但區分大小寫。例如，ABC123 與 abc123 不同，因此不要洗掉它。但是 ABC123 和 ABC123 是一樣的，所以去掉它們。
這是我當前的代碼：
Dim oDic As Object, vData As Variant, r As Long
Set oDic = CreateObject("Scripting.Dictionary")
With worksheets(4).Range("A7:A" & lastRow)
vData = .Value
.ClearContents
End With
With oDic
.comparemode = 0
For r = 1 To UBound(vData, 1)
If Not IsEmpty(vData(r, 1)) And Not .Exists(vData(r, 1)) Then
.Add vData(r, 1), Nothing
End If
Next r
Range("A7").Resize(.Count) = Application.Transpose(.keys)
End With
一些背景：
- 整個資料集大約有 80 萬條記錄
- 腳本沒有錯誤，但結果是錯誤的。當我洗掉重復項（不管區分大小寫，我還剩下 400k）但運行此腳本時，450k（聽起來合法），但只有 60k 記錄有資料，390k 顯示#N/A。所以我不知道哪里出錯了。
提前致謝！
uj5u.com熱心網友回復：
如第一條評論所述，Application.Transpose陣列行數限制為 65,536。請嘗試下一個能夠在沒有此類限制的情況下進行轉置的函式：
Function TranspKeys(arrK) As Variant
Dim arr, i As Long
ReDim arr(1 To UBound(arrK) 1, 1 To 1)
For i = 0 To UBound(arrK)
arr(i 1, 1) = arrK(i)
Next i
TranspKeys = arr
End Function
在您現有代碼所在的同一模塊中復制該功能后，只需將其修改為：
Range("A7").Resize(.Count,1) = TranspKeys(.keys)
uj5u.com熱心網友回復：
唯一值區分大小寫
- 轉置有其局限性，最好避免（還有幾行）。
Option Explicit
Sub DictWith()
With Worksheets(4)
Dim LastRow As Long: LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If LastRow < 7 Then Exit Sub
With .Range("A7:A" & LastRow)
Dim Data As Variant
If .Rows.Count = 1 Then
ReDim Data(1 To 1, 1 To 1)
Data(1, 1).Value = .Value
Else
Data = .Value
End If
With CreateObject("Scripting.Dictionary")
.CompareMode = vbBinaryCompare
Dim Key As Variant
Dim r As Long
For r = 1 To UBound(Data, 1)
Key = Data(r, 1)
If Not IsError(Key) Then
If Len(Key) > 0 Then
.Item(Key) = Empty
End If
End If
Next r
Dim rCount As Long: rCount = .Count
If rCount = 0 Then Exit Sub
ReDim Data(1 To rCount, 1 To 1)
r = 0
For Each Key In .Keys
r = r 1
Data(r, 1) = Key
Next Key
End With
.Resize(rCount).Value = Data
.Resize(.Worksheet.Rows.Count - .Row - rCount 1) _
.Offset(rCount).ClearContents ' clear below
End With
End With
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/409596.html
標籤：
上一篇：從Excel加載項捕獲作業簿事件