Office: Excel 2007 VBA Code für Zellenprüfung

Hallo, nachdem ich hier immer Hilfe zu meinen Fragen erhalten. Bitte ich nochmal um einen kleinen Tipp.

Folgendes Problem habe ich.

Ich habe eine Excel Liste und dort sind 2 Tabellen.

Tabelle 1 mit Kundennummern
Tabelle 2 mit Kundennummern

Nun möchte das aus der Tabelle 1 in der Tabelle 2 die Kundennummern verglichen werden sollen, sollte eine Kundennummer " NICHT " in Tabelle 2 gefunden werden, so soll die ganze Zeile gelöscht werden?

Ist das möglich?

Also übersetzt sollte es ungefähr so aussehen.

Prüfe Kundennummer aus Tabelle 1 in Tabelle 2, wenn Kundennummer in Tabelle 2 vorhanden ist dann soll nichts passieren, falls Kundennummer nicht vorhanden ist, soll die Kundennummer aus Tabelle 1 komplett gelöscht werden.

Falls die Frage auftaucht warum? ich habe in Tabelle 1 Kundennummern wenn diese nicht mehr in der Tabelle 2 sind, dann hat sich der Kunde erledigt und ist nicht mehr in unserem Bestand. Die Tabelle 2 wird 1 mal die WOche aktualisiert.

 

falls Du Dich mit VBA auskennst http://hajo-excel.de/chCounter3/getfile.php?id=69

 

Hi, danke erstmal für die Info.
Leider hilft mir die Tabelle nicht weiter. Dort wird zwar erklärt wie man einen vergleich anstrebt nur das was ich will. das die ganze Zeile direkt gelöscht wird ist nicht in den Tabellen vorhanden, ledeglich das bei einem doppelten Eintrag die Farbe geändert wird. leider kenne ich mich nicht so gut aus in VBA das ich mir den Code selbst umgestallten könnte.

 

ich habe zur Zeit wenig Zeit.
Ich habe nicht gesehen für welches MNakro Du Dich entschieden hast.
Ich habe keine Zeit eione Beispieldatei zu erstellen.
Ich hätte gedacht es ist nur diese Änderung
RaFound.Interior.ColorIndex = 4 ' Zelle markieren
' ersetzen durch
Rows(RaFound.Row).Delete

 

Hallo,

ich habe Dir ein VBA-Makro gebastelt, das die beiden Arbeitsblätter Tabelle1 und Tabelle2 miteinander vergleicht.
1) Vorausgesetzt wird, dass sich die Kundennummer jeweils in der 1. Spalte der verwendeten Bereiche in den beiden Arbeitsblättern befindet.
2) Zum Starten das Makros die Tastenkombination Alt+F8 drücken und anschließend die Eingabe-Taste.
3) Die Zeilen aus Tabelle1, deren KundenNr. in Tabelle2 nicht existieren, werden zur Gänze entfernt.

 

Hi Danke für die Datei. Die ist super.

Allerdings hab ich jetzt das nächste Problem. Am besten ich lade mal meine Datei hoch, ich habe nun versucht diesen Code aus der Datei in meinen zu intergrieren leider funktioniert es nicht. In meiner Liste soll die Tabelle G1 "Kundennummer" mit der Tabelle SRAT "Dossier" verglichen werden. Wenn die Kundennummer aus G501 in SRAT ist soll nichts passieren, falls es die Kundennummer nicht gibt, soll diese Zeile ganz gelöscht werden.

Leider entsteht immer bei mir eine Fehlermeldung.

Bitte um Hilfe:)

 

Hallo,

ich habe Dein Vergleichsmakro um 2 weitere Zeile ergänzt, nämlich:
Application.EnableEvents = False
bzw.
Application.EnableEvents = True

Es lautet jetzt:

Code:

Public Sub Tabelle1u2_Vergleichen()
   Dim Tab1 As Range, Tab4 As Range
   Dim Zl&, KuNr1 As Range, KuNr2 As Range
   
   Set Tab1 = Sheets("G501").UsedRange
   Set Tab4 = Sheets("SRAT").UsedRange
   
   Application.EnableEvents = False
   For Zl& = Tab1.Rows.Count To 2 Step -1
     Set KuNr1 = Tab1.Cells(Zl&, 1)
     KuNr1.Select  'Um beim Löschen zusehen zu können
     Set KuNr2 = Tab4.Columns(1).Find(What:=KuNr1.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, Searchdirection:=xlNext)
     If KuNr2 Is Nothing Then
       'KuNr von Tabelle1 wurde in Tabelle2 nicht gefunden
       '-->Kunde aus Tabelle1 löschen
       KuNr1.EntireRow.Delete
     Else
       'KuNr von Tabelle1 wurde in Tabelle2 gefunden
       '-->keine Aktion
     End If
   Next Zl&
   Application.EnableEvents = True
   
End Sub

Zur Erklärung weshalb es zu einem Fehler kommen musste:
Laufzeitfehler 13: Typen unverträglich.
Fehlerzeile: If LCase(Target) = "x" Then

Du hast für das Arbeitsblatt 'G501' einen Event-Handler für das Change-Ereignis geschrieben. Das Change-Ereignis tritt immer dann ein, wenn im Arbeitsblatt 'G501' eine Veränderung an den Daten eintritt.
Das KundenNr-Vergleichs-Makro überprüft die KundenNr. in Spalte A. Ist dort eine KundenNr. vorhanden, die es im Blatt 'SRAT' nicht gibt, so wird in Blatt 'G501' die ganze betreffende Zeile gelöscht.
Dieses Löschen löst natürlich das Change-Ereignis des Arbeitsblattes aus, an den Target-Parameter des Ereignis-Handlers wird die ganze Zeile als Bereich übergeben (z.B. $8:$8). Mit diesem Wert kann aber spätestens die LCASE-Funktion nichts anfangen (die erwartet sich eine STRING-Variable und keinen Zeilen-Bereich) und löst den Type-Mismatch-Fehler aus.
Ich habe daher im KundenNr-Vergleichsmakro die Ereigniserzeugung ausgeschaltet und schalte sie am Ende wieder an, womit es zu keiner unerwünschten Zwischendurch-Aktivierung des Change-Handlers kommt.

 

Hi Super das klappt Super Gut.
Kannst du mir noch erklären was im Code für was steht? ich wollte das ganze nämlich erweitern für mehrere Tabellen, dachte eigentlich ich erweitere erstmal die Tabellen, aber so leicht ist es nicht. einfach gefragt wenn ich weitere Tabllen hinzufügen will wie trage ich das in der Tabelle nach? Die Funktion soll halt für jedes Tabellenblatt funktionieren.

Code:

Public Sub Tabelle1u2_Vergleichen()
   Dim Tab1 As Range, Tab4 As Range
   Dim Zl&, KuNr1 As Range, KuNr2 As Range
   
   Set Tab1 = Sheets("C501").UsedRange
   Set Tab2 = Sheets("D501").UsedRange
   Set Tab3 = Sheets("E501").UsedRange
   Set Tab4 = Sheets("F501").UsedRange
   Set Tab5 = Sheets("G501").UsedRange
   Set Tab7 = Sheets("SRAT").UsedRange
   
   Application.EnableEvents = False
   For Zl& = Tab1.Rows.Count To 2 Step -1
     Set KuNr1 = Tab1.Cells(Zl&, 1)
     KuNr1.Select  'Um beim Löschen zusehen zu können
     Set KuNr2 = Tab4.Columns(1).Find(What:=KuNr1.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, Searchdirection:=xlNext)
     If KuNr2 Is Nothing Then
       'KuNr von Tabelle1 wurde in Tabelle2 nicht gefunden
       '-->Kunde aus Tabelle1 löschen
       KuNr1.EntireRow.Delete
     Else
       'KuNr von Tabelle1 wurde in Tabelle2 gefunden
       '-->keine Aktion
     End If
   Next Zl&
   Application.EnableEvents = True
   
End Sub

 

Hallo,

ich habe Dir in den folgenden VBA-Makros reichlich Kommentar eingefügt, um die Funktionsweise zu erläutern.
Ich bin davon ausgegangen, dass Du die Konten der Arbeitsblätter C501 bis G501, die nicht im Blatt SRAT enthalten sind, entfernen willst.
Der Aufruf des Makros erfolgt wie bisher unter dem Namen "Tabelle1u2_Vergleichen". Dabei werden die Arbeitsblätter C501-G501 eines nach dem anderen mit dem Arbeitsblatt SRAT verglichen und die nicht im Blatt SRAT enthaltenen Kundennummer aus ihnen entfernt.

Code:

Public Sub Tabelle1u2_Vergleichen()
   
   Vergleich_Blatt_XuK "C501", "SRAT"
   Vergleich_Blatt_XuK "D501", "SRAT"
   Vergleich_Blatt_XuK "E501", "SRAT"
   Vergleich_Blatt_XuK "F501", "SRAT"
   Vergleich_Blatt_XuK "G501", "SRAT"
       
End Sub

Private Sub Vergleich_Blatt_XuK(NameBlattX As String, NameBlattK As String)

   Dim BlattX As Worksheet 'Zeiger auf Arbeitsblattobjekt von NameBlattX
   Dim BereichK As Range   'Zeiger auf verwendeten Bereich von Arbeitsblatt NameBlattK
   Dim KuNrX As Range      'Zeiger auf Zellbereichsobjekt in der 1.Spalte von BlattX.UsedRange
   Dim KuNrK As Range      'Zeiger auf Zellbereichsobjekt in der 1.Spalte von BereichK
   Dim Zl As Long          'Zeilennummer (innerhalb von BlattX.UsedRange) der aktuell bearbeiteten Zeile
  
   'Zuweisen des Arbeitsblattes NameBlattX an Arbeitsblattobjektzeiger BlattX
   Set BlattX = Sheets(NameBlattX)
   'Zuweisen des im Arbeitsblatt NameBlattK verwendeten Bereiches an Bereichsobjektzeiger BereichK
   Set BereichK = Sheets(NameBlattK).UsedRange
   
   'Ausschalten der Ereigniserzeugung (um keine CHANGE-Events auszulösen)
   Application.EnableEvents = False
   'Aktivieren (=Anzeigen) des Arbeitsblattobjektes BlattX
   BlattX.Activate
   'BlattX.UsedRange bezeichnet den verwendeten Bereich im Arbeitsblattobjekt BlattX
   'Man kann im Folgenden (bis zum "End With") bloß mit "." auf diesen Bereich verweisen
   With BlattX.UsedRange
      'Beginne in der letzten Zeile des verwendeten Bereichs von Arbeitsblattobjekt BlattX
      'und gehe Zeile für Zeile nach oben bis in die 2. Zeile des verwendeten Bereichs
      'Die Nummer der aktuell zu bearbeitenden Zeile steht in "Zl"
      For Zl = .Rows.Count To 2 Step -1
        'Weise dem Bereichsobjektzeiger KuNrX die Zelle der 1.Spalte der aktuellen (=Zl) Zeile
        'des verwendeten Bereiches BlattX.UsedRange zu
        Set KuNrX = .Cells(Zl, 1)
        'Zeige diese Zelle als aktive Zelle an
        KuNrX.Select
        'Suche in der 1.Spalte des Bereichsobjektes BereichK nach dem Wert, der im Bereichsobjekt KuNrX enthalten ist
        'Falls dieses Zellobjekt gefunden wurde, weise es dem Bereichsobjektzeiger KuNrK zu
        'Falls kein Zellobjekt gefunden wurde, weise dem Bereichsobjektzeiger den Zeigerwert "Nothing" zu
        Set KuNrK = BereichK.Columns(1).Find(What:=KuNrX.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, Searchdirection:=xlNext)
        If KuNrK Is Nothing Then
          'In KuNrK befindet sich der Wert "Nothing", daher gilt:
          'KuNrX von BlattX wurde in BereichK nicht gefunden
          '-->Ganze Zeile aus BlattX löschen
          KuNrX.EntireRow.Delete
        Else
          'In KuNrK befindet sich ein Zeigerwert auf eine Zelle von BereichK, daher gilt:
          'KuNrX von BlattX wurde in BereichK gefunden
          '-->keine Aktion
        End If
      'Gehe 1 Zeile nach oben im verwendeten Bereich von BlattX
      Next Zl
   'Beende "."-Bezug für BlattX.UsedRange
   End With
   'Einschalten der Ereigniserzeugung (um wieder CHANGE-Events zuzulassen)
   Application.EnableEvents = True
   'Ende des Unterprogrammes, Rückkehr zum aufrufenden Hauptprogramm
End Sub

Installation:
Obigen weißen Bereich mit der Maus markieren, Tasten Strg+C,
bisheriges Makro "Public Sub Tabelle1u2_Vergleichen".."End Sub" zur Gänze markieren, Tasten Strg+V