Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
908to912
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
908to912
908to912
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Suchkriterium neben Suchbereich eintragen

Suchkriterium neben Suchbereich eintragen
25.09.2007 15:26:00
Albert
Hallo,
mit nachfolgendem Code kann ich z.B. die erste Ziffer aus Tabelle 1 in Tabelle 2 suchen lassen und den Inhalt der Zelle (Tab.2) neben mein Suchkriterium in Tabelle 1 schreiben.
Soweit OK.
Nun möchte ich aber z.B. die erste Zifer aus Tabelle 1 in Tabelle 2 suchen lassen und nun jedoch in Tabelle 2 bei jedem gefundenen Ergebnis in die nebenstehende Zelle mein Suchkriterium aus Tabelle 1 (z.B. erste Ziffer) eintragen lassen.
d.h. erste Ziffer in Tab. 1 anwählen, Makro starten, Spalte in Tabelle 2 wird durchgesehen und bei jeder zutreffenden Zelle wird das Suchkriterium danebengeschrieben.
Kann da jemand helfen ?
Vielen Dank!
Ich habe es schon selbst erfolglos versucht.
Viele Grüße
Albert

Sub SuchMich()
Dim rngGefunden As Range
Dim strGesucht As String
strGesucht = Selection.Value
Application.EnableEvents = False
Set rngGefunden = Worksheets("Tabelle2").Cells.Find(strGesucht, Cells(1, 1), xlValues, xlPart,   _
_
xlByRows)
Application.EnableEvents = True
If rngGefunden Is Nothing Then
Selection.Offset(0, 1).Value = "Nix gefunden"
Else
Selection.Offset(0, 1).Value = rngGefunden.Value
End If
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub


Tabelle1
Nr
7972
NK048S
NK612K
698703
708934
630533
699627
659230
661894
2961232
NK048S
NK429K
NK090
NK612K
NK 910
7968
731608
731222
Tabelle2
TEXT1
"Plug Large 43LQD088 1"
"HBS SCHRAUBE 24er 1x 1 "
"PTFE 6mm `$$1111AFKQBD11W. `H838F5006TWSC0W 1"
"Schraube 3,5 2 "
"platte 5-Loch 18 mm 1 "
"Pal LV 64484073 1 "
"PTFE Felt REF007972 43KQI130 1 "
" Serial 925703 Size 19mm 07D087 1"
"LCP Clav Titan rechts, 18, 3- Loch 1 "
"LCP Schraube Titan 3.5 mm 2 "
"draht Stahl 2.5mm 1 "
"Gefäß 731508 79728/1A 0275 1 "
"soft 3016-2400 5000170298 1 "
"Tu 56391050 anqk2429 2 "
"Foil 2,5cm 182507 1 "
"Gefäß 731508 79728/1A 0275 1 "
"Bio 0,5g 060799 2"
"Filz 007972 43KQI130 1 "

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchkriterium neben Suchbereich eintragen
26.09.2007 14:42:45
fcs
Hallo Albert,
mit nachfolgendem Umbau/Ergänzung passiert in etwa das Gewünschte.
MfG
Franz

Sub SuchMich()
Dim rngGesucht As Range, wksSuchen As Worksheet
Dim rngGefunden As Range
Dim strGesucht As String, Adresse as String
Set wksSuchen = Worksheets("Tabelle2")
If ActiveSheet.Name  "Tabelle1" Then
MsgBox "Bitte Makro nur von Tabelle1 aus starten"
Else
Set rngGesucht = Selection
If IsEmpty(rngGesucht) Then Exit Sub 'Leer Zellen nicht Suchen
strGesucht = rngGesucht.Text
Application.EnableEvents = False
Set rngGefunden = wksSuchen.Columns(1).Find(strGesucht, _
wksSuchen.Cells(1, 1), xlValues, xlPart, xlByRows)
Application.EnableEvents = True 'Position dieser Zeile ? evtl. weiter unten
If rngGefunden Is Nothing Then
rngGesucht.Offset(0, 1).Value = "Nix gefunden"
Else
rngGesucht.Offset(0, 1).Value = "gefunden"
Adresse = rngGefunden.Address
Do
'Einfüge-Zelle formatieren
'erforderlich, da z.B. 2.5 sonst in 2,5 umgewandelt wird
rngGefunden.Offset(0, 2).NumberFormat = "@"
rngGefunden.Offset(0, 2).Value = strGesucht
Set rngGefunden = wksSuchen.Columns(1).FindNext(rngGefunden)
Loop Until rngGefunden.Address = Adresse
End If
ActiveCell.Offset(1, 0).Range("A1").Select
End If
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige