Question

VBA Excel中的某些代码一直存在问题，正在寻求帮助！

我正在尝试对具有相应电话号码的姓名列表进行排序，以检查同一电话号码下是否有多个姓名。然后将这些名称发布到另一张纸上。

到目前为止，我的代码是：

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（）将电话号码转换为字符串
调整范围和偏移量

我对这一切还是很陌生的，我只是在此站点上其他帖子的帮助下，在代码上做到了这一点。不知道该去哪里，因为它只是崩溃了，没有错误可查。任何想法表示赞赏，谢谢！

已更新：

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

Update2：

使用hold.Exists和ElseIf来移除GoTo。还对其进行了更改，以将行复制并粘贴到下一张纸上。

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)方法，该方法返回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查找重复项并发布到其他工作表

1 个答案: