Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Löschen funktioniert nicht

Löschen funktioniert nicht
Kai
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

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: For i = 100 To 1 Step-1 oT
19.11.2009 13:02:10
Petra
AW: Löschen funktioniert nicht
19.11.2009 15:12:08
Jens
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
Anzeige
AW: Löschen funktioniert nicht
19.11.2009 22:16:29
Kai
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
AW: Löschen funktioniert nicht
20.11.2009 08:15:35
Jens
Hallo Kai
Lad mal bitte die Datei mit ein paar Beispieldaten hoch.
Gruß Jens
AW: Löschen funktioniert nicht
21.11.2009 10:54:40
Tino
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
Anzeige
Nachtrag Auto steht in Spalte 24
21.11.2009 11:01:22
Tino
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

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige