AW: Fehler Exit Sub
18.05.2021 10:37:47
oraculix
Danke Nepumuk
Bekomme Fehler Sprungmaske definieren wenn ich das so schreibe.
Irgendwo ist da noch ein Fehler.
'Nach dem suchen wird in Tabelle "Gefunden" der gesuchte Eintrag gelistet.
Public Sub AnsehenFindenUndKopieren2(Optional ByVal sWord As String)
Dim iRowT As Long
Dim strFirstAddress As String
Dim objCell As Range
Dim objDictionary As Object
On Error GoTo err_exit
Call GefundenDBLÖSCHEN
Worksheets("FilmeAnsehen").Activate
If sWord = vbNullString Then sWord = InputBox(Prompt:="Suchbegriff:", Default:="Filmname")
If sWord vbNullString Then
Application.ScreenUpdating = False
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
iRowT = 3
With Worksheets("Gefunden")
Set objCell = Union(Columns("A:B"), Columns("H")).Find(What:=sWord, _
LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not objCell Is Nothing Then
strFirstAddress = objCell.Address
Do
If Not objDictionary.Exists(Key:=CStr(objCell.Row)) Then
objDictionary.Item(Key:=CStr(objCell.Row)) = vbNullString
objCell.EntireRow.Copy .Cells(iRowT, 1)
iRowT = iRowT + 1
End If
Set objCell = Union(Columns("A:B"), Columns("H")).FindNext(After:=objCell)
Loop Until objCell.Address = strFirstAddress
Set objCell = Nothing
Set objDictionary = Nothing
.Activate
.UsedRange.Font.Size = 14
With .Range("A2:J5000")
.Font.Color = RGB(255, 192, 0)
.Interior.Color = vbBlack
.Borders.Color = RGB(255, 192, 0)
End With
End If
End With
If iRowT > 3 Then
Worksheets("Gefunden").Activate
Columns("A:A").ColumnWidth = 40.28
Else
Call MsgBox("Nichts gefunden.", vbInformation, "Information")
End If
Application.ScreenUpdating = True
End If
End Sub
err_exit:
End Sub
