AW: Suchen und aktivieren
11.09.2016 19:01:24
fcs
Hallo Jürgen,
hier 2 Makrovarianten
Variante 1:
Beide gesuchten Texte werden eingegeben, nach dem Markieren kann danach dann der Suchtext innerhalb der Markierung eingegeben werden.
Variante 2:
Der 1. gesuchte Texte wird eingegeben, das Makro sucht dann die nächste fett formatierte Zelle, danach kann dann der Suchtext innerhalb der Markierung eineggeben werden.
Gruß
Franz
'Code in einem allgemeinen Modul
Option Explicit
Private varTextA As Variant
Private varTextB As Variant
Private varTextC As Variant
Sub SuchenTextA_und_TextB()
'Sucht die eingegebenen Texte und markiert die Zellen zwischen den Zellen mit den beiden
Dim wks As Worksheet
Dim Zeile_A As Long
Dim Zeile_B As Long
Dim Zelle As Range, rngMarke As Range
Set wks = ActiveSheet
eingabe_A:
varTextA = InputBox("Suchtext A?", "Markieren Zellbereich", varTextA)
If varTextA = "" Then Exit Sub
With wks
Set Zelle = .Range("A:A").Find(what:=varTextA, LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then
MsgBox "Text """ & varTextA & """ in Spalte A nicht gefunden!"
GoTo eingabe_A
Else
Zeile_A = Zelle.Row + 1
Eingabe_B:
varTextB = InputBox("Suchtext B?", "Markieren Zellbereich", varTextB)
If varTextB = "" Then Exit Sub
Set Zelle = .Range("A:A").Find(after:=Zelle, what:=varTextB, LookIn:=xlValues, _
lookat:=xlWhole, searchdirection:=xlNext)
If Zelle Is Nothing Then
MsgBox "Text """ & varTextA & """ in Spalte A nicht gefunden!"
GoTo Eingabe_B
Else
Zeile_B = Zelle.Row - 1
Set rngMarke = .Range(.Cells(Zeile_A, 1), .Cells(Zeile_B, 1))
rngMarke.Select
Eingabe_C:
varTextC = InputBox("gesuchter Text in Markierung?", _
"Markieren Zellbereich", varTextC)
If varTextC = "" Then Exit Sub
Set Zelle = rngMarke.Find(what:=varTextC, _
LookIn:=xlValues, lookat:=xlPart)
If Zelle Is Nothing Then
MsgBox "Suchbegriff """ & varTextC & """ nicht gefunden!"
GoTo Eingabe_C
Else
Zelle.Select
If MsgBox("Weiter suchen?", vbYesNo + vbQuestion, _
"Text suchen in Markierung") = vbYes Then GoTo Eingabe_C
End If
End If
End If
End With
End Sub
Sub SuchenTextA_und_Fett()
'Sucht den Suchtext und anschliessend die nächste fett formatierte Zelle _
und markiert die Zellen dazwischen
Dim wks As Worksheet
Dim Zeile_A As Long
Dim Zeile_B As Long, Zeile_L As Long
Dim Zelle As Range, rngMarke As Range
Set wks = ActiveSheet
eingabe_A:
varTextA = InputBox("Suchtext A?", "Markieren Zellbereich", varTextA)
If varTextA = "" Then Exit Sub
With wks
Set Zelle = .Range("A:A").Find(what:=varTextA, LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then
MsgBox "Text """ & varTextA & """ in Spalte A nicht gefunden!"
GoTo eingabe_A
Else
Zeile_A = Zelle.Row + 1
Zeile_B = Zeile_A
Zeile_L = Cells(.Rows.Count, 1).End(xlUp).Row
Do Until .Cells(Zeile_B + 1, 1).Font.Bold = True
Zeile_B = Zeile_B + 1
If Zeile_B = Zeile_L Then
Exit Do
End If
Loop
Set rngMarke = .Range(.Cells(Zeile_A, 1), .Cells(Zeile_B, 1))
rngMarke.Select
Eingabe_C:
varTextC = InputBox("gesuchter Text in Markierung?", _
"Text suchen in Markierung", varTextC)
If varTextC = "" Then Exit Sub
Set Zelle = rngMarke.Find(what:=varTextC, _
LookIn:=xlValues, lookat:=xlPart)
If Zelle Is Nothing Then
MsgBox "Suchbegriff """ & varTextC & """ nicht gefunden!"
GoTo Eingabe_C
Else
Zelle.Select
If MsgBox("Weiter suchen?", vbYesNo + vbQuestion, _
"Text suchen in Markierung") = vbYes Then GoTo Eingabe_C
End If
End If
End With
End Sub