zwei Sub Befehlsinhalte kombinieren

  • Excel

    zwei Sub Befehlsinhalte kombinieren

    Hallo Zusammen,
    habe heute eine Bitte. Kann mir bitte jemand schreiben, wie ich die Ergebnisdarstellung aus diesem Sub Code

    VB.NET-Quellcode

    1. Private Sub CommandButton4_Click()
    2. Dim rng1 As Range
    3. Dim C As Range
    4. Dim objDic
    5. Dim strMsg As String
    7. Set objDic = CreateObject("scripting.dictionary")
    8. Set rng1 = Range([a1:h1], Cells(Rows.Count, "A").End(xlUp))
    9. For Each C In rng1
    10. If Len(C.Value) > 0 Then
    11. If Not objDic.exists(C.Value) Then
    12. objDic.Add C.Value, 1
    13. Else
    14. strMsg = strMsg & C.Value & " in cell " & C.Address(0, 0) & vbNewLine
    15. End If
    16. End If
    17. Next
    18. If Len(strMsg) > 0 Then MsgBox strMsg
    19. End Sub

    mit der Suchabfrage von diesem Sub Code

    VB.NET-Quellcode

    1. Private Sub CommandButton7_Click()
    2. '################################################
    3. 'Code für ein allgemeines Modul
    4. 'Autor: Jürgen Hennekes
    5. '################################################
    6. Dim objDic As Object
    7. Dim strString As String
    8. Dim lngZ As Long
    9. Dim lngLast As Long
    11. Set objDic = CreateObject("Scripting.Dictionary")
    12. lngLast = Cells(Rows.Count, 1).End(xlUp).Row
    14. For lngZ = lngLast To 2 Step -1
    15. strString = Cells(lngZ, 1).Value & Cells(lngZ, 2).Value & Cells(lngZ, 3).Value _
    16. & Cells(lngZ, 4).Value & Cells(lngZ, 5).Value & Cells(lngZ, 6).Value & Cells(lngZ, 7).Value _
    17. & Cells(lngZ, 8).Value
    18. If objDic.exists(strString) = False Then
    19. objDic(strString) = 0
    20. Else
    21. Cells(lngZ, 1).EntireRow.Delete
    22. End If
    23. Next
    24. End Sub

    so vereinen kann, das mir als Ergebnis der SubCode nur wirklich die Zeile(n) in die Message Box
    schreibt, die sich als 100% Dublikate herausgestellt haben.
    Zur Zeit zeigt mir das erste Sub zwar doppelte Zellen an aber vergleicht nicht den Zusammenhang
    der Zellen innerhalb der Zeile. Das zweite Sub löscht mir genau die Zeilen, die wirklich als gewünschtes
    Ergebnis doppelt sind. Ich würde mir die aber gerne vorher anschauen bevor sie gelöscht werden.
    Deshalb mein Wunsch zur Kombi aus den zwei Subs - ich kriegs nicht hin.

    Für eure Hinweise und Lösungsansätze / Lösungen bedanke ich mich sehr
    mfg, Michael

Facebook
Telefonspende