Microsoft Excel

Herbers Excel/VBA-Archiv

Löschen funktioniert nicht | Herbers Excel-Forum


Betrifft: Löschen funktioniert nicht von: Kai
Geschrieben am: 19.11.2009 12:52:16

Hallo,

möchte alle DS löschen (ab Zeile 3) , die in Spalte X kein "Auto" stehen haben.

Dim i
For i = 1 To 100
If Cells(i, 24).Value <> "Auto" Then _
Cells(i, 1).EntireRow.Delete
Next i

Problem 1: irgend wie funktioniert der Code nicht richtig, er löscht immer nur die untersten und ich muss ein paar mal die Funktion ausführen ehe alle weg sind.

Problem 2: in den Zeilen, die gelöscht werden sollen, sind teilweise Grafiken eingefügt. Wird eine Zeile gelöscht, bleibt die Grafik dazu stehen.
Gibt es noch einen anderen Lösch -Befehl ?

Danke für Eure Hilfe

Kai

  

Betrifft: AW: For i = 100 To 1 Step-1 oT von: Petra
Geschrieben am: 19.11.2009 13:02:10




  

Betrifft: AW: Löschen funktioniert nicht von: Jens
Geschrieben am: 19.11.2009 15:12:08

Hallo Kai

Zu 1)

Wie Petra schon geschrieben hat:

Sub tt()
Dim i As Integer
For i = 100 to 1
If Cells(i, 24) <> "Auto" Then
Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub
Zeilen immer von unten nach oben löschen. Warum?

Angenommen in X20 und X21 steht "Auto".
Bei Deinem Code löscht er dann die Zeile 20. Somit wird Zeile 21 zu Zeile 20. Die Variable i wird aber nach dem löschen um 1 erhöht (ist dann also 21). Somit wird die jetzige Zeile 20 zum Löschen übersprungen.

Zu 2)
Wie sind die Grafiken denn eingebunden? Von Zellgröße und -position abhängig?
Dann kann man über die TopLeft-Eigenschaft die Grafik löschen.

Lad doch mal die Mappe hoch. Dann kann man das darauf anpassen.

Gruß aus dem Sauerland

Jens


  

Betrifft: AW: Löschen funktioniert nicht von: Kai
Geschrieben am: 19.11.2009 22:16:29

Hallo Jens,

ich lade meine Grafiken so:

If ActiveSheet.Cells(i, 6).Value = "Bild" Then
Range("G3").Select
Sheets("Grafiken").Select
ActiveSheet.Shapes("Picture 18").Select
Selection.Copy
Sheets("Daten").Select
Cells(i, 8).Select
ActiveSheet.Paste
End If

Also im Prinzip einfach per copy / paste. Die Grafiken liegen auf einem anderen Tabellenblatt.

Gruss
Kai


  

Betrifft: AW: Löschen funktioniert nicht von: Jens
Geschrieben am: 20.11.2009 08:15:35

Hallo Kai

Lad mal bitte die Datei mit ein paar Beispieldaten hoch.

Gruß Jens


  

Betrifft: AW: Löschen funktioniert nicht von: Kai
Geschrieben am: 20.11.2009 10:27:10

Hier eine Beispieldatei:

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

Gruss


  

Betrifft: AW: Löschen funktioniert nicht von: Tino
Geschrieben am: 21.11.2009 10:54:40

Hallo,
versuche es mal so.

Sub LoscheGrafig()
Dim oShab As Shape, i As Integer
Dim meAr() As String
With Tabelle2
    
    For Each oShab In .Shapes
     If oShab.BottomRightCell.Column = 8 Then
       If oShab.Type = msoPicture Then
        Redim Preserve meAr(i)
        meAr(i) = oShab.Name
        i = i + 1
       End If
     End If
    Next oShab
    
    If i > 0 Then .Shapes.Range(meAr).Delete
End With
End Sub

Sub Grafik_laden()
Dim i&
Call LoscheGrafig
With Tabelle2
For i = 1 To 500
    If .Cells(i, 6).Value = "green" Then
        Sheets("Tabelle2").Shapes("Picture 19").Copy
        .Cells(i, 8).PasteSpecial
    End If
Next i
End With
End Sub

Sub Loeschen_Mit_Formel()
Dim oSH As Worksheet, iCalc As Integer
Dim strSuchwert As String


strSuchwert = "Auto"

Set oSH = Tabelle2 'Tabelle anpassen 

With Application
 iCalc = .Calculation
 .Calculation = xlCalculationManual
 .ScreenUpdating = False
 
     With oSH.UsedRange
        With .Columns(.Columns.Count).Offset(0, 1)
            
            .Formula = "=IF(RC2<>""" & strSuchwert & """,True,ROW())" 'entsprechende Formel 
            
             oSH.UsedRange.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
            
            On Error Resume Next
             .SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
             .EntireColumn.Delete
            On Error GoTo 0
        End With
     End With
  Call Grafik_laden
 .ScreenUpdating = True
 .Calculation = iCalc
End With

End Sub
Gruß Tino


  

Betrifft: Nachtrag Auto steht in Spalte 24 von: Tino
Geschrieben am: 21.11.2009 11:01:22

Hallo,
im ersten Beitrag schreibst Du, dass Du Auto in Spalte 24 suchst.

mach aus der Zeile

.Formula = "=IF(RC2<>""" & strSuchwert & """,True,ROW())" 'entsprechende Formel

diese

.Formula = "=IF(RC24<>""" & strSuchwert & """,True,ROW())" 'entsprechende Formel

Gruß Tino


Beiträge aus den Excel-Beispielen zum Thema "Löschen funktioniert nicht"