Live-Forum - Die aktuellen Beiträge
Datum
Titel
30.04.2024 21:27:28
Bei Autofilter immer leere Zeilen einschließen
30.04.2024 20:46:46
Dopplungen Markieren, nur wenn die Zelle nebenan ident. ist
30.04.2024 20:14:55
Datum filtern
30.04.2024 19:41:34
VBA: Zellinhalt wird nicht angezeigt
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1920to1924
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1920to1924
1920to1924
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Doppelte Einträge überprüfen

Doppelte Einträge überprüfen
03.03.2023 17:05:09
Chris
Hallo Forum,
ich möchte per untenstehendem Makro den variablen Bereich ab D5 auf doppelte Einträge überprüfen. Dies Makro funktioniert soweit, außer beim ersten Eintrag in D5.
HIer sagt Excel, dass der Eintrag bereits ab D5 vorhanden ist.
Was muss geändert werden, damit die D5 beim ersten Eintrag ignoriert wird, ab dem zweiten Eintrag (ab D6) jedoch D5 wieder berücksichtigt wird?
Vielen Dank
Chris

Dim lngzelle As Long
Dim arr As Variant
Dim iRow As Integer
On Error Resume Next
lngzelle = Sheets("Daten").Cells(Rows.Count, 4).End(xlUp).Row 
arr = Sheets("Daten").Range("D5:D" & lngzelle -1) 
iRow = Application.Match(Sheets("Daten").Range("BA4").Value, arr, 0)
If err > 0 Then
Else
MsgBox "Bereits vorhanden" 
With Sheets("Daten")
.Rows(ActiveCell.Row).EntireRow.Delete
.Range("F" & lngzelle).Offset(-1, 1).Activate
Exit Sub
End With
End If
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Doppelte Einträge überprüfen
03.03.2023 19:49:57
onur
"auf doppelte Einträge überprüfen" ? Und auch noch ohne Schleife?
Dein Code macht nix anderes als EINMAL in Spalte D ab Zeile 5 bis zur letzten benutzten Zeile nach dem Wert in BA4 zu suchen. Wenn was gefunden wurde, wird das Ergebnis (die Zeilenpostion, die ermittelt wurde) ignoriert und einfach die Zeile der aktuell aktiven Zelle gelöscht und die aktive Zelle um je 1 nach oben und rechts versetzt.
Wozu ermittelst du überhaupt, wo das gesuchte steht, wenn das Ergebnis sowieso keine Rolle im Code spielt ?
Mehr macht dein Code nicht.
AW: Doppelte Einträge überprüfen
03.03.2023 20:05:23
Chris
Hallo Onur,
ich erkläre, was ich lösen möchte: Das Makro oben ist nur ein Teil.
Immer wenn in Spalte D in der letzten benutzen Zelle +1 ein neuer Wert eingegeben wird sollen ab D5 bis zur gerade eben benutzten Zelle -1 alle Werte mit dem aktuell eingegebenen überprüft werden. Wenn vorhanden, soll nur der aktuell eingegebene Wert gelöscht werden, der bereits vorher evtl. vorhandene Wert soll erhalten bleiben.
Danach soll die Zelle rechts des letzten vorhandenen Wertes selektiert werden.
Gruß
Anzeige
AW: Doppelte Einträge überprüfen
03.03.2023 20:07:17
Chris
Nachtrag: Prinzipiell funktioniert das Makro, nur eben Zelle D5 - als erste Zelle des Arrays - wird mitgeprüft und es kommt die Meldung, dass der Wert bereits vorhanden ist. Sicherlich gibt es aber noch bessere Lösung(en) als meine..
AW: Doppelte Einträge überprüfen
03.03.2023 20:52:49
onur
Dann such mal Jemanden, der, ohne die Datei zu haben, einen halben Code analysieren möchte.
AW: Doppelte Einträge überprüfen
03.03.2023 21:28:19
Chris
Hallo Onur,
ist gelöst und funktioniert! ActiveCell.row -1 schränkt das Array auf die passende Größe ein, wenn man ab D4 die Suche beginnt.
Gruß Chris
 Dim lngzelle As Long
    Dim arr As Variant
    Dim iRow As Integer
    
    On Error Resume Next
    
    lngzelle = ActiveCell.Row - 1
    lngzelle2= Sheets("Daten").Cells(Rows.Count, 4).End(xlUp).Row 
    
    arr = Sheets("Daten").Range("D4:D" & lngzelle) 
    iRow = Application.Match(Sheets("Daten").Range("BA4").Value, arr, 0)
    
    If err > 0 Then
    Else
    MsgBox "Bereits vorhanden" 
    
    With Sheets("Daten")
    .Rows(ActiveCell.Row).EntireRow.Delete
    .Range("F" & lngzelle2).Offset(-1, 1).Activate
    Exit Sub
    End With
    
    End If
    
    End Sub

Anzeige
AW: Doppelte Einträge überprüfen
03.03.2023 22:30:41
Yal
Hallo Chris,
"wenn ein Wert eingegeben wird" deutet auf das Ereignis-Prozedure "Worksheet_Change". Du gibst eine "End Sub" aber nicht den Start "Sub ...()"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Erg As Double
    
'On Error Resume Next
    
'With Worksheets("Daten")'Bei einem Worksheet_Change MUSS es bereits Worksheets("Daten") sein
    Application.EnableEvents = False
    If Target.Column = 4 Then 'Nur bei Eingabe in Spalte D
        If Target.Row > 4 Then 'nur ab Zeile 5
            Erg = Application.Match(Target.Value, Range(.Range("D5"), Target.Offset(-1)), 0)
            If Not IsError(Erg) Then
                MsgBox "Bereits vorhanden"
                Target.Offset(1,1).Select
                Target.EntireRow.Delete
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub
VG
Yal
Anzeige
AW: Doppelte Einträge überprüfen
04.03.2023 06:53:14
Chris
Hi Yal,
danke für den Tipp und das Makro, auch dies läuf!
GRuß
Chris

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige