mit VBA Zellen löschen

[Enclave]

Fehler beim Kompilieren:
Mehrfachdeklaration im aktuellen Gültigkeitsbereich

[Steffl]

Hallo,

du hattest im Post #14 ein Makro ohne Sub ... und End Sub gepostet. Diese habe ich ergänzt und das mußt Du durch deine tatsächliche Version ändern. bzw. kürzen.

[Enclave]

das hab ich gemacht ^^, ich hab etwas angepasst, jetzt kommt kein Fehler.Funktionieren tut es trotzdem nicht



Sub prcX()
  Dim x, rSuchErgebnis As Range
  Dim I As Long
  Dim rDaten As Range
 
  Application.ScreenUpdating = False
 
  With Worksheets("Zahlen zählen")
     
      Set rDaten = Range("TabelleRecherche")
      For I = rDaten.Rows.Count To 1 Step -1  ' Range("TabelleRecherche").Resize(Range("TabelleRecherche").Rows.Count, 1)
     
      If LCase(rDaten.Cells(I, 1).Value) = "x" Then
     
        Set rSuchErgebnis = .Range("A4:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Find(what:=rDaten.Cells(I, 3).Value, LookIn:=xlValues, Lookat:=xlWhole)
        If Not rSuchErgebnis Is Nothing Then
            Do
              'namen vergleichen auch wenns ne fast direkte referenz ist
              If (rDaten.Cells(I, 3).Value & rDaten.Cells(I, 4).Value) = (rSuchErgebnis.Value & rSuchErgebnis.Offset(0, 1).Value) Then
                  rSuchErgebnis.Resize(1, 5).ClearContents 'Delete xlShiftUp 'zeile löschen
                  rDaten.Cells(I, 1).ClearContents  'x entfernen
              End If
             
              Set rSuchErgebnis = Range("A4:A" & .Cells(Rows.Count, "A").End(xlUp).Row).FindNext(rSuchErgebnis)
             
            Loop While Not rSuchErgebnis Is Nothing
        End If
      End If
     
      Next
     
  End With

End Sub

[Steffl]

Hallo,

da fehlt in der Codezeile mit dem FindNext noch ein Punkt vor dem Range

Code:

Set rSuchErgebnis = .Range("A4:A" & .Cells(Rows.Count, "A").End(xlUp).Row).FindNext(rSuchErgebnis)

[Enclave]

geht leider nicht. hier werden beide mit gleichen Nachnamen gelöscht.

[Steffl]

Hallo,

Du suchst ja auch nur in einer Spalte.

Nachtrag:

Nach nochmaligen Betrachten deiner Tabellen, habe ich es bemerkt. Ändere den Code so ab

Code:

Sub prcX()
   Dim x, rSuchErgebnis As Range
   Dim I As Long
   Dim rDaten As Range
   Dim strFirstTreffer As String
  
   Application.ScreenUpdating = False
  
   With Worksheets("Zahlen zählen")
      
      Set rDaten = Range("TabelleRecherche")
      For I = rDaten.Rows.Count To 1 Step -1  ' Range("TabelleRecherche").Resize(Range("TabelleRecherche").Rows.Count, 1)
      
      If LCase(rDaten.Cells(I, 1).Value) = "x" Then
      
         Set rSuchErgebnis = .Range("A4:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Find(what:=rDaten.Cells(I, 3).Value, LookIn:=xlValues, Lookat:=xlWhole)
         If Not rSuchErgebnis Is Nothing Then
            strFirstTreffer = rSuchErgebnis.Address
            Do
               'namen vergleichen auch wenns ne fast direkte referenz ist
               If (rDaten.Cells(I, 3).Value & rDaten.Cells(I, 4).Value) = (rSuchErgebnis.Value & rSuchErgebnis.Offset(0, 1).Value) Then
                  rSuchErgebnis.Resize(1, 5).ClearContents 'Delete xlShiftUp 'zeile löschen
                  rDaten.Cells(I, 1).ClearContents  'x entfernen
               End If
               Set rSuchErgebnis = .Range("A4:A" & .Cells(Rows.Count, "A").End(xlUp).Row).FindNext(rSuchErgebnis)
            Loop While strFirstTreffer <> rSuchErgebnis.Address
         End If
      End If
      
      Next
      
   End With

End Sub

[Enclave]

Objektvariable oder With-Blockvariable nicht festgelegt

Will nicht 

[Steffl]

Hallo,

für mich nicht reproduzierbar, da mir in deiner Datei in den entsprechenden Spalten auf den Tabellenblättern die Daten fehlen.

[Enclave]

Auf der Seite Recherche hast du 2x Spohn bei mir funktioniert es nicht^^

[Steffl]

Hallo,

kann Spohn J auf der Seite Recherche zweimal vorhanden sein?