VBA SUCHFELD
04.08.2022 21:44:29
Jens
Ich möchte eine Fehlerliste programmieren. Auf der AKTUELL Seite befinden sich eine Liste mit Fehlern , Verursachern usw usw.
Des weiteren habe ich ein Suchfeld "programmiert" mit dem u.g. VBA Code (im Internet gefunden).
Wenn ich dieses Anklicke und den Suchbegriff eingebe finde ich auch die gesuchten Begriffe auf den entsprechenden Arbeitsblättern. Dort habe ich dann je Teil ein Makro um DATEN der einzelnen Teile auf der AKTUELL Fehlerliste einzufügen. ( Ich hoffe das ist verständlich. Die DATEN Bestehen aus Namen Nummern Farbcodes etc etc )
Soweit funktioniert das. Sobald ich dann mit klick auf das DATEN Makro meine Daten auf der AKTUELL Seite einfügen lasse,
findet mein SUCHEN Makro danach keine Begriffe mehr.
Zum einen möchte ich auf allen Seiten suchen, außer der AKTUELL Seite, da dort die Suchbegriffe mehrfach auftauchen werden
Zum anderen möchte ich nach dem Klick aufs DATEN Makro direkt wieder zur AKTUELL Seite geleitet werden :)
Ich hoffe es ist alles verständlich erklärt, nachvollziehbar und mir kann irgendjemand helfen :) Wie gesagt, bin absoluter Neuling auf dem Gebiet. Google hilft viel aber, nunja :)
SUCHEN MAKRO:
Option Explicit
Global SSearch As String
Public Sub SearchAllTables()
Dim ws As Worksheet
Dim c
Dim firstAddress As String
Dim secAddress
Dim GFound As Boolean
Dim GWeiter As Boolean
GWeiter = False
GFound = False
anf:
SSearch = InputBox("Suchen nach:", "Stichwort-Suche / Suchfunktion", SSearch)
If SSearch = "" Then
End
End If
weiter:
For Each ws In Worksheets
'ws.Select
With ws.Cells
Set c = .Find(SSearch, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
GFound = True
ws.Select
c.Select
firstAddress = c.Address
If MsgBox("Weitersuchen?", vbQuestion + vbYesNo) = vbYes Then
Do
Set c = .FindNext(c)
secAddress = c.Address
If c.Address = firstAddress Then
Exit Do
End If
c.Select
If MsgBox("Weitersuchen?", vbQuestion + vbYesNo) = vbNo Then
GWeiter = True
GoTo ende
End If
Loop While Not c Is Nothing And secAddress firstAddress And c.Address firstAddress
Else
GWeiter = True
GoTo ende
End If
End If
End With
Next ws
ende:
If GFound = False Then
If MsgBox("Suchwert nicht gefunden! Neue Suche?", vbInformation + vbYesNo) = vbYes Then
GoTo anf:
End If
Else
If GWeiter = False Then
If MsgBox("Es wurden alle in Frage kommenden Suchbegriffe angezeigt! Soll die Suche neu gestartet werden?", vbInformation + vbYesNo) = vbYes Then
GoTo weiter
End If
End If
End If
End Sub
Sub DATEN()
Dim rngCopy As Range, rngLetzte As Range
Dim SpalteZ As Long, ZeileN As Long
Set rngCopy = Worksheets("Zierleiste").Range("D4")
With ActiveWorkbook.Worksheets("AKTUELL")
SpalteZ = 4 'Spalte in der K2 eingefügt werden soll 1 = A, 2 = B usw.
ZeileN = 2 '1. Zeile in der kopierte Werte einfügt werden sollen
'letzte benutzte Zelle ermitteln
Set rngLetzte = .Range(.Columns(SpalteZ), .Columns(SpalteZ + rngCopy.Columns.Count - 1)) _
.Find(What:="*", After:=.Cells(1, SpalteZ), LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not rngLetzte Is Nothing Then
ZeileN = IIf(rngLetzte.Row rngCopy.Copy
.Cells(ZeileN, SpalteZ).PasteSpecial Paste:=xlPasteFormats
.Cells(ZeileN, SpalteZ).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End With
End Sub