Excel VBA 查找重复项并 post 找到不同的 sheet

Question

我一直在使用 VBA 中的某些代码时遇到问题 Excel 正在寻求帮助！

我正在尝试对具有相应 phone 号码的姓名列表进行排序，检查同一 phone 号码下的多个姓名。然后 post 将这些名称单独 sheet.

到目前为止我的代码是：

Sub main()
    Dim cName As New Collection
    For Each celli In Columns(3).Cells
    Sheets(2).Activate
        On Error GoTo raa
            If Not celli.Value = Empty Then
            cName.Add Item:=celli.Row, Key:="" & celli.Value
            End If
    Next celli
        On Error Resume Next
raa:
    Sheets(3).Activate
    Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
    Resume Next
End Sub

当我尝试运行代码时它崩溃了 Excel，并且没有给出任何错误代码。

我尝试解决问题的一些事情：

简短的项目列表
使用 cstr()
调整范围和偏移量

我对这一切还很陌生，在本网站其他 post 的帮助下，我才设法在代码上走到这一步。不知道该去哪里，因为它只是崩溃并且没有给我任何错误来调查。任何想法表示赞赏谢谢！

已更新：

Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow

Sub main()
    Set output = Worksheets("phoneFlags")
    Set data = Worksheets("filteredData")

    Set hold = CreateObject("Scripting.Dictionary")
        For Each celli In data.Columns(3).Cells
            On Error GoTo raa
            If Not IsEmpty(celli.Value) Then
                hold.Add Item:=celli.Row, Key:="" & celli.Value
            End If
        Next celli
        On Error Resume Next
raa:
    nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
    output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
    'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
    Resume Next
End Sub

更新2：

使用 hold.Exists 和 ElseIf 删除了 GoTo。还将其更改为将行复制并粘贴到下一个 sheet.

Sub main()
    Set output = Worksheets("phoneFlags")
    Set data = Worksheets("filteredData")
    Set hold = CreateObject("Scripting.Dictionary")

    For Each celli In data.Columns(2).Cells
        If Not hold.Exists(CStr(celli.Value)) Then
            If Not IsEmpty(celli.Value) Then
                hold.Add Item:=celli.Row, Key:="" & celli.Value
            Else
            End If
        ElseIf hold.Exists(CStr(celli.Value)) Then
            data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
            'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
        End If
    Next celli
End Sub

Answer 1

开发代码时，不要尝试（或害怕）错误，因为它们是帮助修复代码或逻辑的指针。因此，除非在编码算法 (*) 中绝对指明，否则不要使用 On Error。在不必要时使用 On Error 只会隐藏错误，不会修复它们，并且在编码时最好首先避免错误（良好的逻辑）。

添加到词典时，首先检查该项目是否已经存在。 Microsoft 文档指出，尝试添加已存在的元素会导致错误。 Dictionary 对象相对于 VBA 中的普通 Collection 对象的一个优势是 .exists(value) 方法，returns 和 Boolean.

既然我已经了解了上下文，那么对您的问题的简短回答是，您可以先检查 (if Not hold.exists(CStr(celli.Value)) Then)，然后在它不存在时添加。

(*) 作为旁注，我昨天正在解决一个 Excel 宏问题，这让我花了一天的大部分时间来解决这个问题，但是错误的出现和调试代码的使用帮助我做出了一些稳定的代码，而不是一些有问题但可以正常工作的代码（这是我首先要修复的代码）。但是，在某些情况下使用错误处理可能是一种捷径，例如：

Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
    tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
    On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
        Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
        tResult = True
    On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
    RangeExists = tResult
End Function

Excel VBA 查找重复项并 post 找到不同的 sheet

Excel VBA Find Duplicates and post to different sheet

sorting

crash

excel

vba