1

我有一个用于 excel 的 VBA 宏来查找重复项。它可以工作，但它被指定给某个列。我想搜索第一行的列标题并找到名为“Email”的标题（最好是“Email*”，因为有时这个标题在“Email”字之后包含一些其他字）。我认为这个脚本不会根据行数进行调整，并且限制为 65536 个值。我宁愿让这个脚本适应列中值的数量。我有一个类似的 VBA 宏，它做得很完美。我以为我可以使用这个宏作为示例并修改我目前正在处理的那个……但是我失败了。谁能帮我对第一个代码进行适当的修改？

我想修改的 VBA 宏：

Option Explicit

Sub DeleteDups()

Dim x As Long
Dim LastRow As Long
Sheets("test").Activate
LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
    If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
        Range("A" & x).Interior.Color = RGB(255, 48, 48)
    End If
Next x

End Sub

VBA 宏运行良好，我想以此为例：

Function getAllColNum(ByVal rowNum As Long, ByVal searchString As Variant) As Object
Dim allColNum As Object
Dim i As Long
Dim j As Long
Dim width As Long
Set allColNum = CreateObject("Scripting.Dictionary")
colNum = 1
With ActiveSheet
    width = .Cells(rowNum, .Columns.Count).End(xlToLeft).Column
    For i = 1 To width
         If InStr(UCase(Trim(.Cells(rowNum, i).Value)), UCase(Trim(searchString))) > 0 Then
             allColNum.Add i, ""
         End If '
    Next i
End With
Set getAllColNum = allColNum
End Function



Sub GOOD_WORKS_No_Dots_at_End_of_Emails()
Dim strSearch As String
strSearch = "Email"
Dim colNum As Variant
Dim allColNum As Object
Sheets("Data").Activate
Dim LR As Long, i As Long
Set allColNum = getAllColNum(1, searchString)
For Each colNum In allColNum
    LR = Cells(Rows.Count, colNum).End(xlUp).Row
    For i = 1 To LR
        With Range(Cells(i, colNum), Cells(i, colNum))
            If Right(.Value, 1) = "." Then .Value = Left(.Value, Len(.Value) - 1)
        End With
    Next i
Next colNum
Sheets("Automation").Activate
MsgBox "No Dots at the end of email addresses - Done!"
End Sub

到目前为止我的工作

Function getAllColNum(ByVal rowNum As Long, ByVal searchString As Variant) As Object
Dim allColNum As Object
Dim i As Long
Dim j As Long
Dim width As Long
Set allColNum = CreateObject("Scripting.Dictionary")
colNum = 1
With ActiveSheet
width = .Cells(rowNum, .Columns.Count).End(xlToLeft).Column
For i = 1 To width
     If UCase(Trim(.Cells(rowNum, i).Value)) Like UCase(Trim(searchString)) Then
         allColNum.Add i, ""
     End If '
Next i
End With
Set getAllColNum = allColNum
End Function



Sub testing_testing()
Dim strSearch As String
strSearch = "Email"
Dim colNum As Variant
Dim allColNum As Object
Sheets("Data").Activate
Dim LR As Long, i As Long
Set allColNum = getAllColNum(1, searchString)
For Each colNum In allColNum
LR = Cells(Rows.Count, colNum).End(xlUp).Row
For i = 1 To LR
    With Range(Cells(i, colNum), Cells(i, colNum))
        If Application.WorksheetFunction.CountIf(Range("R1:A" & x), Range("R" & x).Text) > 1 Then
    Range("A" & x).Interior.Color = RGB(255, 48, 48)
    End With
    End If
Next i
Next colNum
Sheets("Automation").Activate
MsgBox "Finiding duplicates - Done!"
End Sub

似乎更复杂，正如我提到的，我对 VBA 的了解有限。但是，我发现了一个不同的脚本，它可能更容易修改。

此宏查找电子邮件地址列并标记整个列

Option Explicit

Sub GOOD_WORKS_Mark_Email_Duplicates()

Dim x As Long
Dim LastRow As Long
Sheets("test").Activate
LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
    If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
        Range("A" & x).Interior.Color = RGB(255, 48, 48)
    End If
Next x
MsgBox "Email duplicates has been marked - red cells. Check if there are any red cells in the Email column"
End Sub

这个使用countif函数找到重复项（这对我很好。唯一的问题是我有这个宏作为一个按钮，其中指定了范围

Sub Highlight_Duplicates(Values As Range)
Dim Cell

For Each Cell In Values
If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then
    Cell.Interior.ColorIndex = 6
End If

Next Cell
End Sub

然后是操作按钮：

Private Sub CommandButton1_Click()
Highlight_Duplicates (Sheets("Test").Range("C2:C92"))

End Sub

我可以先运行第一个宏，然后再运行第二个。但是，我不知道如何摆脱动作按钮中的 Range 。有任何想法吗？

4

1 回答 1

0

在你的 getAllColNum 函数中，改变这个：

If InStr(UCase(Trim(.Cells(rowNum, i).Value)), _
         UCase(Trim(searchString))) > 0 Then

对此：

If UCase(Trim(.Cells(rowNum, i).Value)) Like UCase(Trim(searchString)) Then

这将允许您传递通配符标题，如“电子邮件”并获取所有匹配的列。

于 2013-02-11T19:45:44.040 回答