Einzelne Buchstaben Löschen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim i As Long Dim raus As Range With Worksheets("FilmInfo") For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row If InStr(1, .Cells(i, 2), "(") = 0 Then If raus Is Nothing Then Set raus = .Cells(i, 2) Else Set raus = Union(raus, .Cells(i, 2)) End If End If Next If Not raus Is Nothing Then raus.EntireRow.Delete End If End With Set raus = Nothing

Sub Bilder_raus() Dim BC As Object For Each BC In ActiveSheet.Pictures BC.Delete Next BC 'Alles was keine Jahr hat löschen Dim i As Long Dim raus As Range With Worksheets("FilmInfo") For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row If InStr(1, .Cells(i, 2), "(") = 0 Then If raus Is Nothing Then Set raus = .Cells(i, 2) Else Set raus = Union(raus, .Cells(i, 2)) End If End If Next If Not raus Is Nothing Then raus.EntireRow.Delete End If End With Set raus = Nothing End Sub

Danke Nepomuk super jetzt geht es und die Buttons bleiben.
Kann man den VBA Code noch beschleunigen das dauert fasst 4 Minuten.
Ich meine nicht Deinen VBA Code der darunter
"Alles was keine Jahre hat löschen"
eigentlich sollten ja nur Buchstaben von a-z gelöscht werden und die Wörter Home und Alle Filme
Ich denke das ginge wesentlich schneller.
'Bilder aus Info update Löschen


Private Sub CommandButton7_Click()
Dim objShp As Shape
Application.ScreenUpdating = False
For Each objShp In ActiveSheet.Shapes
If objShp.Type = msoPicture Then objShp.Delete
Next
Dim i As Long
Dim raus As Range
'Alles was keine Jahre hat löschen
With Worksheets("FilmInfo")
For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
If InStr(1, .Cells(i, 2), "(") = 0 Then
If raus Is Nothing Then
Set raus = .Cells(i, 2)
Else
Set raus = Union(raus, .Cells(i, 2))
End If
End If
Next
If Not raus Is Nothing Then
raus.EntireRow.Delete
End If
End With
Set raus = Nothing
End Sub

Gruß
Oraculix

Private Sub CommandButton7_Click() Dim lngLetter As Long Dim objCell As Range Dim objShp As Shape Application.ScreenUpdating = False With Worksheets("FilmInfo") For Each objShp In .Shapes If objShp.Type = msoPicture Then objShp.Delete Next 'Alles was keine Jahre hat löschen For lngLetter = 65 To 90 Set objCell = .Columns(2).Find(What:=Chr$(lngLetter), _ LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) If Not objCell Is Nothing Then objCell.EntireRow.Delete Next Do Set objCell = .Columns(2).Find(What:="Home", _ LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) If Not objCell Is Nothing Then objCell.EntireRow.Delete Else Exit Do End If Loop Do Set objCell = .Columns(2).Find(What:="Alle Filme", _ LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) If Not objCell Is Nothing Then objCell.EntireRow.Delete Else Exit Do End If Loop End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Einzelne Buchstaben Löschen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread