Microsoft Excel

Herbers Excel/VBA-Archiv

Zellen löschen | Herbers Excel-Forum


Betrifft: Zellen löschen von: Walter
Geschrieben am: 20.11.2009 20:48:59


Hallo Excel Freunde,
Ich habe eine sehr große Tabelle, sechs Ziffern habe ich in einer Hilfsspalte zusammengezogen, getrennt durch ein ";".
Es sollen die Zellen gelöscht werden mit 6,5,4,und 3 aufeinanderfolgende Ziffern.
z. B. 4;5;6 oder 8;9;10;11;12. nach dem Löschen soll die Zelle aufrücken.
Danke für Euere Hilfe.

Walter

  

Betrifft: AW: Zellen löschen von: Uwe Küstner
Geschrieben am: 21.11.2009 00:11:17

Hallo Walter,

probiere es mal hiermit:

Sub ZeilenLoeschen()
  Dim vnB As Variant, vnZ As Variant
  Dim i As Long, x As Integer, y As Integer
  Dim rngB As Range
  Set rngB = Range("B1:B100") '< entsprechend anpassen
  vnB = rngB.Value
  For i = UBound(vnB) To 1 Step -1
    vnZ = Split(vnB(i, 1), ";")
    If UBound(vnZ) = 5 Then
      y = 1
      For x = 0 To 4
        If CInt(vnZ(x)) = CInt(vnZ(x + 1)) - 1 Then
          y = y + 1
          If y = 3 Then
            rngB.Rows(i).EntireRow.Delete
            Exit For
          End If
        Else
          y = 1
        End If
      Next x
    End If
  Next i
End Sub
Gruß Uwe


  

Betrifft: AW: Zellen löschen von: Daniel
Geschrieben am: 21.11.2009 14:59:44

Hi

probiers mal damit:

Sub ZeilenLöschen()
    With ActiveSheet.UsedRange
        With .Columns(.Columns.Count).Offset(0, 1)
            .FormulaR1C1 = "=if(FolgePrüfen(RC??),"""",Row())" 
                '--für ?? die Spaltennummer der  Hilfsspalte eintragen
            .Formula = .Value
            .EntireRow.Sort Key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
            If .Application.CountBlank(.Cells) Then _
                    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            .EntireColumn.Delete
        End With
    End With
End Sub



Public Function FolgePrüfen(Zeichenfolge As String) As Variant
Dim Ziffer() As String
Dim i As Long
Dim chk As Long
Ziffer = Split(Zeichenfolge, ";")
FolgePrüfen = False
For i = 1 To UBound(Ziffer)
    Select Case Ziffer(i) - Ziffer(i - 1)
        Case 1
            chk = chk + 1
            If chk = 2 Then
                FolgePrüfen = True
                Exit Function
            End If
        Case Else
            chk = 0
    End Select
Next
End Function

Gruß, Daniel


  

Betrifft: AW: Zellen löschen von: Walter
Geschrieben am: 22.11.2009 08:04:47


Guten Morgen Uwe und Daniel,
Ich bekomme es nicht hin. Liegt sicher an meinen VBA Kenntnisse.
Habe nun alle Daten in Spalten A bis DX verteilt. Ziffern stehen in den Zellen
und sind durch Komma getrennt. Könnt Ihr bitte Euer Lösung so ändern, damit ich sie
einbauen kann.
Danke und verzeiht mir meine Unkenntnis,
Gruß
Rentner Walter


  

Betrifft: Beispiel Lösche Folge von: Tino
Geschrieben am: 22.11.2009 09:54:52

Hallo Walter,
habe Dir mal ein Beispiel aufgebaut, ich hoffe dass ich dich richtig verstanden habe.

https://www.herber.de/bbs/user/66078.xls

Beim öffnen wird eine Liste generiert worauf das eigentliche Makro getestet werden kann.
Wiederherstellen des Beispiels geht auch über den entsprechenden Button den ich eingebaut habe.

Bei mir braucht dieses Makro bei 22800 Einträgen 1,04 Sekunde.

Gruß Tino


  

Betrifft: AW: Lad mal deine Datei hoch von: Daniel
Geschrieben am: 22.11.2009 18:12:40

sonst ist es ja nicht möglich, das Makro zu testen und ggf anzupassen.
außerdem war von dir die Vorgabe, daß die Zahlen bereits in einer Hilfsspalte stehen, durch Semikolons getrennt.
Dies bitte beachten, da die Makros von Uwe und mir darauf abgestimmt sind.
wenn das nicht so ist, müsstest du deine Datei entsprechend ändern, damit es funktioniert.


Gruß, Daniel


  

Betrifft: AW: Lad mal deine Datei hoch von: Walter
Geschrieben am: 23.11.2009 13:06:55

Hallo Daniel,
Hier eine Datei in abgeänderter Form, ist aber im Prinzip das Gleiche.

https://www.herber.de/bbs/user/66114.xls

Danke für Deine Hilfe

Gruß
Walter


  

Betrifft: So sollte es gehen von: Uwe Küstner
Geschrieben am: 23.11.2009 13:42:10

Hallo Walter,

Du hast geschrieben, die Zahlen sind mit ";" getrennt, in deiner Datei jedoch mit ","! ;-)
Hab es angepasst.

Sub ZeilenLoeschen()
  Dim vnZ As Variant
  Dim i As Long, x As Integer, y As Integer
  Dim rngB As Range
  Set rngB = Range("A1").CurrentRegion
  Application.ScreenUpdating = False
  For i = rngB.Cells.Count To 1 Step -1
    vnZ = Split(rngB.Cells(i), ",")
    If UBound(vnZ) = 5 Then
      y = 1
      For x = 0 To 4
        If CInt(vnZ(x)) = CInt(vnZ(x + 1)) - 1 Then
          y = y + 1
          If y = 3 Then
            rngB.Cells(i).Delete xlUp
            Exit For
          End If
        ElseIf CInt(vnZ(x)) <= CInt(vnZ(x + 1)) - 20 Then
          rngB.Cells(i).Delete xlUp
          Exit For
        Else
          y = 1
        End If
      Next x
    End If
  Next i
  Application.ScreenUpdating = True
End Sub

Gruß Uwe


  

Betrifft: AW: So sollte es gehen von: Walter
Geschrieben am: 23.11.2009 14:42:18

Hallo Uwe,
heißen Dank, klappt besser als unsere Türen.

Gruß
Rentner Walter (70)
aus dem nördlichen Nordhessen


Beiträge aus den Excel-Beispielen zum Thema "Zellen löschen"