doppelte finden über vba

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
Ein kleines Beispiel


Option Explicit

Public Sub KundenVgl()

    Dim maxCells As Long, i As Long
    Dim objDictionary As Object

    With Worksheets("Tabelle1")    'Tabellenname anpassen 
        maxCells = .Cells(.Rows.Count, 1).End(xlUp).Row

        Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
        For i = 5 To maxCells

            If objDictionary.Exists(Key:=.Cells(i, 1).Text) Then
                If objDictionary(.Cells(i, 1).Text) = .Cells(i, 7).Text Then
                    MsgBox "Duplicate gefunden, Datum gleich " & _
                    .Cells(i, 1).Text & "/" & .Cells(i, 7).Text & "/" & _
                    objDictionary(.Cells(i, 1).Text)
                Else
                    MsgBox "Duplicate gefunden, Datum ungleich " & _
                    .Cells(i, 1).Text & "/" & .Cells(i, 7).Text & "/" & _
                    objDictionary(.Cells(i, 1).Text)
                End If

            Else
                objDictionary.Add Key:=.Cells(i, 1).Text, Item:=.Cells(i, 7).Text
            End If

        Next i
    End With

    Set objDictionary = Nothing
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

Hallo Peter,
Danke für deine Hilfe, ich lerne gerade VBA deswegen übe ich :-)
Aber er müsste es so zeigen:
hier muss jetzt die Meldung kommen " Kunde 8987777 doppelt mit Datum 19.05.2019 und 01.01.2018
SpalteA 89877777----SpalteG 19.05.2019
SpalteA 89877777----SpalteG 19.05.2019
SpalteA 89877777----SpalteG 01.01.2018
SpalteA 89877777----SpalteG 19.05.2019
SpalteA 89877777----SpalteG 19.05.2019
hier darf gar nichts kommen, weil es so okay ist, da kein anderes Datum hinterlegt ist.
SpalteA 97125851----SpalteG 19.05.2019
SpalteA 97125851----SpalteG 19.05.2019
SpalteA 97125851----SpalteG 19.05.2019
Es reicht wenn die Meldung einmal pro Kunde kommt, da der Kunde teilweise 100mal in der Spalte vorkommt.
Danke dir Peter

Sub test() Dim arrK, arrD Dim dicK As Object, dicD As Object Dim z As Long Dim KD Dim Erg As String arrK = Range(Cells(5, 1), Cells(5, 1).End(xlDown)).Value arrD = Range(Cells(5, 7), Cells(5, 7).End(xlDown)).Value Set dicK = CreateObject("Scripting.dictionary") Set dicD = CreateObject("Scripting.dictionary") For z = 1 To UBound(arrK, 1) KD = arrK(z, 1) If dicK.exists(KD) Then Set dicD = dicK(KD) Else Set dicD = CreateObject("Scripting.dictionary") End If dicD(arrD(z, 1)) = dicD(arrD(z, 1)) + 1 Set dicK(KD) = dicD Next For Each KD In dicK.keys If dicK(KD).Count > 1 Then Erg = Erg & vbLf & KD Next If Erg = "" Then MsgBox "alles ok" Else MsgBox "folgende Kunden sind zu prüfen:" & Erg End If End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

doppelte finden über vba

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread