AW: Zellen in Tabelle suchen Zeile markieren
11.11.2003 07:42:32
WernerB.
Hallo Thomas,
leider hast Du nicht geschrieben, woher das Makro wissen soll, was die Werte 1, 2 und 3 sind. Im nachstehenden Lösungsvorschlag bin ich deshalb davon ausgegangen, dass diese Werte in den Zellen A1, A2 und A3 stehen.
Option Explicit
Sub Thomas()
Dim SuBe As Range
Dim s1 As String, s2 As String, s3 As String
Dim laRQ As Long, laRZ As Long
Application.ScreenUpdating = False
laRQ = Cells(Rows.Count, 7).End(xlUp).Row
s1 = Range("A1").Value
s2 = Range("A2").Value
s3 = Range("A3").Value
Set SuBe = Range("G1:G" & laRQ).Find(s1, lookat:=xlWhole)
If Not SuBe Is Nothing Then
laRZ = Sheets("Wert1").Cells(Rows.Count, 1).End(xlUp).Row
If laRZ = 1 And Sheets("Wert1").Range("A1").Value = "" Then laRZ = 0
Rows(SuBe.Row).Copy
Sheets("Wert1").Range("A" & laRZ + 1).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Else
MsgBox "Wert1 nicht gefunden !", vbOKOnly + vbInformation, _
"Dezenter Hinweis für " & Application.UserName & ":"
End If
Set SuBe = Range("G1:G" & laRQ).Find(s2, lookat:=xlWhole)
If Not SuBe Is Nothing Then
laRZ = Sheets("Wert2").Cells(Rows.Count, 1).End(xlUp).Row
If laRZ = 1 And Sheets("Wert2").Range("A1").Value = "" Then laRZ = 0
Rows(SuBe.Row).Copy
Sheets("Wert2").Range("A" & laRZ + 1).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Else
MsgBox "Wert2 nicht gefunden !", vbOKOnly + vbInformation, _
"Dezenter Hinweis für " & Application.UserName & ":"
End If
Set SuBe = Range("G1:G" & laRQ).Find(s3, lookat:=xlWhole)
If Not SuBe Is Nothing Then
laRZ = Sheets("Wert3").Cells(Rows.Count, 1).End(xlUp).Row
If laRZ = 1 And Sheets("Wert3").Range("A1").Value = "" Then laRZ = 0
Rows(SuBe.Row).Copy
Sheets("Wert3").Range("A" & laRZ + 1).PasteSpecial Paste:=xlAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Else
MsgBox "Wert3 nicht gefunden !", vbOKOnly + vbInformation, _
"Dezenter Hinweis für " & Application.UserName & ":"
End If
Set SuBe = Nothing
Application.ScreenUpdating = True
End Sub
Viel Erfolg wünscht
WernerB.
P.S.: Das Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter (siehe Forums-FAQ).