以下代碼不會洗掉任何重復項，我錯過了什么？
LastColumn = 10
ws.Range(ws.Cells(1, ws.Range("AY1").Column LastColumn - 1).Address(), ws.Cells(1, "AY").Address()).RemoveDuplicates
我換過RemoveDuplicates通過.Select檢查，如果選擇了除外范圍，這是。
uj5u.com熱心網友回復：
請測驗下一個方法。它將只保留第一次出現并用空單元格替換下一個重復項。處理的結果在下（第二）行回傳（出于測驗原因）。如果它按您的需要作業，您可以簡單地替換 ws.Range("AY2").Resize為 ws.Range("AY1").Resize：
Sub removeDuplicatesOnRow()
Dim ws As Worksheet, lastColumn As Long, arrCol, i As Long
lastColumn = 10
Set ws = ActiveSheet
arrCol = ws.Range(ws.cells(1, ws.Range("AY1").Column lastColumn - 1), ws.cells(1, "AY")).value
arrCol = removeDuplKeepEmpty(arrCol)
ws.Range("AY2").Resize(1, UBound(arrCol, 2)).value = arrCol
End Sub
Function removeDuplKeepEmpty(arr) As Variant
Dim ar, dict As Object, i As Long
ReDim ar(1 To 1, 1 To UBound(arr, 2))
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr, 2)
If Not dict.Exists(arr(1, i)) Then
dict(arr(1, i)) = 1
ar(1, i) = arr(1, i)
Else
ar(1, i) = ""
End If
Next i
removeDuplKeepEmpty = ar
End Function
如果您只需要在連續列中保留唯一值/字串，則可以調整該函式來執行此操作。您沒有回答我關于這個問題的澄清問題，我假設您不想破壞已處理行下方的列。但是，如果我的假設是錯誤的，我可以發布一個相反的代碼......
uj5u.com熱心網友回復：
洗掉行重復
Option Explicit
Sub RemoveRowDuplicates()
Dim ws As Worksheet: Set ws = ActiveSheet ' be more specific
Dim fCell As Range: Set fCell = ws.Range("AY1")
Dim lCell As Range: Set lCell = ws.Cells(1, ws.Columns.Count).End(xlToLeft)
If lCell.Column < fCell.Column Then Exit Sub ' no data in row range
Dim rg As Range: Set rg = ws.Range(fCell, lCell)
Dim cCount As Long: cCount = rg.Columns.Count
If cCount < 2 Then Exit Sub ' only one column
Dim sData As Variant: sData = rg.Value ' Source
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare ' ignore case i.e. 'A = a'
Dim dData As Variant: ReDim dData(1 To 1, 1 To cCount) ' Dest. (Result)
Dim sValue As Variant
Dim sc As Long
Dim dc As Long
For sc = 1 To cCount
sValue = sData(1, sc)
If Not IsError(sValue) Then ' is not an error value
If Len(sValue) > 0 Then ' is not blank
If Not dict.Exists(sValue) Then ' not found in dictionary
dict(sValue) = Empty
dc = dc 1
dData(1, dc) = sValue
'Else ' found in dictionary
End If
'Else ' is blank
End If
'Else ' is error value
End If
Next sc
rg.Value = dData
MsgBox "Found " & dc & " unique values.", vbInformation
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/366805.html
標籤：vba
上一篇：VBA無法識別[紅色]數字格式