Excel VBA查找重復項並發布到其他工作表

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不必要時使用On Error只會隱藏錯誤，不能修復它們，而在編碼時始終最好一開始就避免錯誤（良好的邏輯）。

在添加到詞典中時，首先檢查該項目是否已經存在。 Microsoft文檔指出，嘗試添加已經存在的元素會導致錯誤。 Dictionary對象相對於VBA中的普通Collection對象的一個​​優點是.exists(value)方法，該方法返回Boolean 。

現在，有了我的上下文，對您的問題的簡短回答是，您可以先檢查（ if Not hold.exists(CStr(celli.Value)) Then ），然后添加（如果不存在）。

（*）作為附帶說明，我昨天解決了一個Excel宏問題，這使我花了整整一天的時間來解決問題，但是錯誤的產生和調試代碼的使用幫助我制作了一些穩定的代碼，而不是一些有問題的bug工作代碼（這是我首先修復的問題）。 但是，在某些情況下，使用錯誤處理可能是捷徑，例如：

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