Wert suchen und markieren

Forumthread: Wert suchen und markieren

Einzel

Hallo,
habe eine Datei wo ich nach Stäben suche. Nun möchte ich, wenn ich z.B. 2 Eingabe alle
Zellen die hinter der 2 liegen makieren.
Im Beispiel wäre das bei Eingabe von 2:
C9:C15 und E9:J15
habe schon mal ein VBA angefangen nur leider markiert er mir nur E9:E15
Hat jemand noch ne idee wie ich das Markro ändern muss.
Hier mal die Datei als .xls
https://www.herber.de/bbs/user/68563.xls
MfG
Stephan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Wert suchen und markieren

15.03.2010 18:47:56

Chris

Servus,
probiers mal so:

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 = Range(Cells(SuchK.Row, 5), Cells(SuchK.Row, Cells(SuchK.Row, Columns.Count) _
.End(xlToLeft).Column))
Else
Set rAlle = Union(rAlle, 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!"
End If
rAlle.Select
Set rAlle = Nothing
Set SuchK = Nothing
End Sub

Gruß
Chris

AW: kleine Korrektur

15.03.2010 18:50:10

Chris

Servus,

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 = Range(Cells(SuchK.Row, 5), Cells(SuchK.Row, Cells(SuchK.Row, Columns.Count) _
_
.End(xlToLeft).Column))
Else
Set rAlle = Union(rAlle, 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

Ausstieg bei nicht gefunden vergessen, sonst gibts einen Fehler.
Gruß
Chris

AW: kleine Korrektur

15.03.2010 18:59:18

Einzel

Hi,
das klappt schon super.
Leider werden die dazugehöriegen Zellen C9:C15 nicht mit Markiert.
Gruß
Stephan

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

AW: Dann so!

15.03.2010 19:11:47

Einzel

Supi danke, genau so sollte es sein.
Gruß
Stephan

Beliebteste Forumthreads (12 Monate)

Forumthread: Wert suchen und markieren

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Wert suchen und markieren

Forumthread: Wert suchen und markieren

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread