Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1840to1844
1840to1844
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Einzelne Buchstaben Löschen

Forumthread: Einzelne Buchstaben Löschen

Einzelne Buchstaben Löschen
26.07.2021 10:26:47
oraculix
Hallo
In Spalte B habe ich immer wieder Einträge die durch das Updaten der Datenbank immer wieder gelöscht werden müssen.
Beispiel Einzelne Buch staben von A-Z und gewisse Wörter.
Ich habe Euch alles in Roter Schrift in der Beispielmappe markiert damit Ihr seht was gelöscht werden muss.
Das Ganze sollte per VBA auf Knopfdruck geschehen.
https://www.herber.de/bbs/user/147304.xlsx
Danke
Gruß
Oraculix
Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: Einzelne Buchstaben Löschen
26.07.2021 11:13:34
hary
Moin
Ich geh mal davon aus die nicht zuloeschende Zelle enthaelt immmer das Jahr in Klammern.

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
gruss hary
Anzeige
AW: Einzelne Buchstaben Löschen
26.07.2021 11:30:56
oraculix
Super das geht so auch , alle wege führen nach Rom!
Vielen Dank.
Noch ein Kleines Problem hätte ich noch.
Wenn ich das Update mache kommen auch Bilder dazu zum Text die Löschen möchte mit VBA.
Deshalb habe ich jetzt Deinen Genialen Code erweitert aber leider werden auch meine Commandbuttons gelöscht.
Wie kann ich nur die Bilder Löschen und die Commandbuttons sollen erhalten bleiben?
'Bilder aus Info update Löschen

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

Anzeige
AW: Einzelne Buchstaben Löschen
27.07.2021 07:44:55
Nepumuk
Hallo,
so:

Public Sub Bilder_raus()
Dim objShape As Shape
For Each objShape In ActiveSheet.Shapes
If objShape.Type = msoPicture Then Call objShape.Delete
Next
End Sub
Gruß
Nepumuk
AW: Einzelne Buchstaben Löschen
27.07.2021 09:04:25
oraculix
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
Anzeige
AW: Einzelne Buchstaben Löschen
27.07.2021 09:23:16
Nepumuk
Hallo,
so besser?

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
Gruß
Nepumuk
Anzeige
AW: Einzelne Buchstaben Löschen
27.07.2021 10:24:02
oraculix
Ja viel besser und schneller Danke genau so wollte ich es haben.
Vor allem das gute an dem Code ist das man noch Wörter hinzufügen kann
Super gelöst!!!
Gruß
Oraculix
kost fast nix
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige