ich versuche ein Makro zu schreiben, das in Spalte A jedes Arbeitsblattes nach einem Wert sucht und die gefundene Zeile markiert aber ich schaffe es nicht.
Kann mir jemand weiter helfen?
Markus
Sub FindAndMark()
Dim wksSheet As Worksheet
Dim objCell As Object
Dim strReferenceArray() As String
Dim strMatchValue As String
Dim strMultiReference As String
Dim lngReferenceCounter As Long
Dim lngCounter As Long
Dim lngStartSheet As Long
strMatchValue = "test"
lngStartSheet = ActiveSheet.Index
Application.ScreenUpdating = False
For Each wksSheet In ActiveWorkbook.Worksheets
Erase strReferenceArray
lngReferenceCounter = 0
strMultiReference = ""
For Each objCell In wksSheet.Range("A:A")
If objCell.Value = strMatchValue Then
ReDim Preserve strReferenceArray(lngReferenceCounter)
strReferenceArray(lngReferenceCounter) = objCell.Address
lngReferenceCounter = lngReferenceCounter + 1
End If
Next objCell
For lngCounter = 0 To lngReferenceCounter - 1
strMultiReference = strMultiReference & "," & strReferenceArray(lngCounter)
Next lngCounter
wksSheet.Select
Range(Right(strMultiReference, Len(strMultiReference) - 1)).Select
Next wksSheet
Sheets(lngStartSheet).Select
Application.ScreenUpdating = True
End Sub
Sub Suchen()
Dim rng As Range
Dim sAddresse, sAdd, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
Set rng = Columns(1).Find(what:=sFind, lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then
sAddresse = rng.Address(False, False)
sAdd = sAddresse
rng(1, 1).Activate
Do
Set rng = Columns(1).FindNext(after:=ActiveCell)
If Not rng Is Nothing Then
If rng.Address(False, False) = sAddresse Then Exit Do
rng(1, 1).Activate
sAdd = sAdd & "," & rng(1, 1).Address(False, False)
End If
Loop
End If
Range(sAdd).Select
End Sub
Sub Suchen()
Dim rng As Range
Dim sRow, sAdd, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
Set rng = Columns(1).Find(what:=sFind, lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then
sRow = rng.Row
sAdd = sRow & ":" & sRow
rng(1, 1).Activate
Do
Set rng = Columns(1).FindNext(after:=ActiveCell)
If Not rng Is Nothing Then
If rng.Row = sRow Then Exit Do
rng(1, 1).Activate
sAdd = sAdd & "," & rng(1, 1).Row & ":" & rng(1, 1).Row
End If
Loop
End If
Range(sAdd).Select
End Sub