mit VBA Zellen löschen

[Enclave]

ich habe erkannt das er  wenn die zellen in einer Reihe sind das makro nur jede zweite zelle löscht
also: 1 2 3 4 5 6 7 8 werden nur 2 4 6 8 gelöscht.

vlt hilft das ja ^^


  Mittagspausen.xlsm (Größe: 534,83 KB / Downloads: 6)

[Enclave]

Jemand eine Idee wie man mir helfen könnte?

[ralf_b]

ich hab dir das mal umgschrieben, sodas die Spalte mit den x werten von unten abgearbeitet wird. 
die Zeilen werden nicht gelöscht nur leer gemacht.  kannst das ja selbst anpassen
ich habe es getestet und es werden 5 x in reihe untereinander gelöscht. 

Code:

Sub loeschenMA()

    Dim x, rSuchErgebnis As Range
    Dim i As Long
    Dim rDaten As Range
 
   
   Application.ScreenUpdating = False
   
    'und ein geschützter Bereich , vielen Dank für die Info.
     With Worksheets("Zahlen zählen")
       
        .Unprotect Password:="test"
     
         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
                   
                     '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
                End If
             End If
         Next

        .Protect Password:="test"
    End With
  Application.ScreenUpdating = True
set rdaten = Nothing
set rSuchErgebnis = Nothing
End Sub

[Enclave]

Hallo zusammen,
ich habe nochmal ein Problem wo ich eure Hilfe brauche

bei dem Code findet er den Nachnamen richtigerweise. aber wenn der Nachname doppelt vor kommt kontrolliert er nicht nach der nächsten Spalte (den Vornamen)
Habt ihr eine Idee?

  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:A300" & .Cells(Rows.Count, "A").End(xlUp).Row).Find(what:=rDaten.Cells(I, 3).Value, LookIn:=xlValues, Lookat:=xlWhole)
                If Not rSuchErgebnis Is Nothing Then
                 
                    '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
              End If
            End If
           
        Next
       

       
    End With

[schauan]

Hallöchen,

erst mal nur ein Tipp - muss gleich weg - suche hier bei uns mal nach FINDNEXT

[Enclave]

hm,, also ich hab mal versucht was mit findnext zu basteln aber leider hatte ich kein erfolg. hatte dann nur die Fehlermeldung "Objektvaribale oder With Blockvariable nicht festgelegt

[Steffl]

Hallo,

dann zeige uns dein Konstrukt.

[Gast 123]

Hallo an allle ....

ich bin erstaunt, sehr erstaunt, im Forum Codes zum Löschen mit For EAch in Range() zu finden. Wie soll das bitte funktionieren???

Als alter Mann, mit bescheidenem Excel 97 Programmierwissen, woraus ich KEINEN Hehl mache ist mir bekannt, ich schreibe es gross:
Löschen ist nur mit Rückwärts For Next mit Step -1  möglich!!   
Sonst bleibt die letzte Zeile unberücksichtigt, weil For Each das nicht begreifen kann!!  Das gehört bitte zum VBA Standard Wissen.

Ich habe mir das Beispiel geladen und sehe es mir in Ruhe an, aber heute muss ich zuerst wichtige private Dinge erledigen.

mfg Gast 123

---

Nachtrag  ich kenne nicht den exakten internen Ablauf von For Each Range(), aber Excel weiss intern was als naechste Zeile kommt. Wenn man eine Zeile weglöscht begreift das der innere Zeilenzaehler nicht und überspringt eine Zeile!

[Enclave]

Danke das du mir helfen willst,
ich hab den Code "damals" so bekommen und genutzt weil er funktioniert, (halt nur nicht wenn der Name doppelt vor kommt)

@Steffl mein  Konstrukt habe ich wieder gelöscht weil es nicht funktionert hat und es mir Peinlich war soetwas anderen zu zeigen

[Steffl]

Hallo,

mal ungetestet

Code:

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:A3" & .Cells(Rows.Count, "A").End(xlUp).Row).FindNext(rSuchErgebnis)
            Loop While Not rSuchErgebnis Is Nothing
         End If
      End If
      
      Next
      
   End With

End Sub