Löschen funktioniert nicht

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

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

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

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Löschen funktioniert nicht

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

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread