Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1144to1148
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
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

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

Betreff
Benutzer
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
AW: Dann so!
15.03.2010 19:11:47
Einzel
Supi danke, genau so sollte es sein.
Gruß
Stephan

310 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige