AW: Dann so!
15.03.2010 19:06:30
Chris
Sub Lesen()
Dim Lesen1 As String
Dim SuchK As Range
Dim nächste As Integer
Dim rAlle As Range, strErste As String
'Eingabe des Stabes
Lesen1 = InputBox("Stabnummer eintragen.", "Zumbach V1.0")
If Lesen1 = "" Then Exit Sub
'Stäbe finden in Spalte 1 und die nächste Zelle Markieren
Set SuchK = Range("A2:A65536").Find(Lesen1, LookAt:=xlWhole, LookIn:=xlValues)
If Not SuchK Is Nothing Then
strErste = SuchK.Address
'nächste = Application.WorksheetFunction.CountA(Range(Cells(SuchK.Row, 1), Cells(SuchK.Row, _
256)))
'Cells(SuchK.Row, 4 + 1).Select
Do
If rAlle Is Nothing Then
Set rAlle = Union(Range("C" & SuchK.Row), Range(Cells(SuchK.Row, 5), Cells(SuchK.Row, _
Cells(SuchK.Row, Columns.Count).End(xlToLeft).Column)))
Else
Set rAlle = Union(rAlle, Range("C" & SuchK.Row), Range(Cells(SuchK.Row, 5), Cells( _
SuchK.Row, Cells(SuchK.Row, Columns.Count).End(xlToLeft).Column)))
End If
Set SuchK = Range("A2:A65536").FindNext(SuchK)
Loop While Not SuchK Is Nothing And SuchK.Address strErste
Else
MsgBox "Stab: " & Lesen1 & " nicht gefunden!", vbCritical, "Fehler!"
Exit Sub
End If
rAlle.Select
Set rAlle = Nothing
Set SuchK = Nothing
End Sub
Gruß
Chris