AW: Schuß ins Blaue...
22.08.2021 12:06:22
oraculix
ja sorry der Rest des Macros is so schlecht das ich ihn nicht posten wollte aber naja muss wohl sein.
Danke
'Info Aktualisieren
Private Sub CommandButton7_Click()
Dim lngLetter As Long
Dim objCell As Range
Dim objShp As Shape
Application.ScreenUpdating = False
Application.EnableEvents = 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
Do
Set objCell = .Columns(2).Find(What:="Andere", _
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:="0..9", _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not objCell Is Nothing Then
objCell.EntireRow.Delete
Else
Exit Do
End If
Loop
End With
' Formatiern und Doppelpunkte löschen
Range("B2:B30000").Select
ActiveWindow.ScrollRow = 4573
ActiveWindow.ScrollRow = 4519
ActiveWindow.ScrollRow = 3659
ActiveWindow.ScrollRow = 2368
ActiveWindow.ScrollRow = 1265
ActiveWindow.ScrollRow = 486
ActiveWindow.ScrollRow = 2
Selection.Font.Bold = True
Selection.Font.Size = 12
Selection.Font.Size = 14
With Selection.Font
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.799981688894314
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlLeft
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Replace What:=":", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("B1").Select
Call CommandButton2_Click
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub