Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1532to1536
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
Inhaltsverzeichnis

suchliste

suchliste
28.12.2016 16:21:42
bassi2008
Hallo liebe Exceler :-)
ich habe etwas "gestohlen" und möchte es etwas anpassen.
Anbei eine Bsp.Datei.
Ich möchte gern mit der Suchfunktion in allen Spalten der Range A:D suchen.
Dieses Ergebnis soll in der Listbox angezeigt werden.
Das klappt auch dank meiner (modifizierten) "gestohlenen" Vorlage super.
Nun ist das Konstrukt aber so gestaltet, dass in der Listbox an erster Stelle immer der Wert dargestellt wird, der auch gesucht wurde.

With Me.ListBox1
.ColumnCount = 4
.AddItem
.List(.ListCount - 1, 0) = rngCell.Value
.List(.ListCount - 1, 1) = rngCell.Offset(0, 1).Value
.List(.ListCount - 1, 2) = rngCell.Offset(0, 2).Value
.List(.ListCount - 1, 3) = rngCell.Offset(0, 3).Value
.ColumnWidths = "2,5cm;1,5cm;2,5cm;2,5cm"
End With
Ich möchte aber, wenn ich z.B. einen Wert aus der zweiten oder dritten Spalte suche, trotzdem eine unveränderte Anzeige nach A, B, C, D.
In der Listbox soll immer ganz links die erste Zeile der Range A:D, also Spalte A angezeigt werden.
Kann mir da jemand vielleicht unter die Arme greifen?
Viele Grüße
bassi
https://www.herber.de/bbs/user/110220.xlsm

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: suchliste
28.12.2016 16:23:31
Hajo_Zi
List(.ListCount - 1, 0) = rngCell.Offset(0, 0).Value

AW: suchliste
28.12.2016 16:28:17
bassi2008
Guten Tag Hajo,
das ging aber super schnell.
Besten Dank.
Jedoch ist der Effekt derselbe.
Gebe ich ein Suchbegriff aus C ein, wird auch dieser Begriff aus C in der ganz linken Spalte der Listbox angezeigt.
Schade...
Viele Grüße
bassi
AW: suchliste
28.12.2016 16:30:08
Hajo_Zi
ich hätte es wahrscheinlich anders gelöst
           .List(.ListCount - 1, 0) = Cells(rngCell.Row, 1)
.List(.ListCount - 1, 1) = Cells(rngCell.Row, 2)
.List(.ListCount - 1, 2) = Cells(rngCell.Row, 3)
.List(.ListCount - 1, 3) = Cells(rngCell.Row, 4)
Ob Row oder Rows musst Du mal testen.
Gruß Hajo
Anzeige
AW: suchliste
28.12.2016 16:35:07
bassi2008
Hajo, das ist absolut perfekt.
Super.
Eine Frage noch hintendran:
Kann man auch noch dazupacken, dass die Zelle in der Spalte A des dazugehörigen Ergebnisses markiert wird. Also select oder acitvate?
Japp... ich weiß... nicht elegant. Aber ich erhoffe mir damit den Rest des Makros selber zusammen stricken zu können :-)
Viele Grüße
bassi
AW: suchliste
28.12.2016 16:53:01
bassi2008
:-) "... der Curser ist kein Hund..." hihi... so schön hat das ja auch noch keiner ausgedrückt.
Aber du hast freilich recht. Soweit mir das - mit meinem begrenzten Wissensstand - möglich ist, bereinige ich sowas auch. Aber es hilft eben ungemein wenn man den Code einzeln per F8 nachgeht... Also mir hilft das jedenfalls...
Danke für die Links. Werd ich mir zu Gemüte führen. Ich glaub ich muss noch viel lernen :-(
Habe nun den Alternativcode zu meinem "select" getestet.
Diesmal klappt das aber nicht so wie angedacht.
Die Zelle wird nicht eingefärbt (wobei das einfärben ja nicht unbedigt der Effekt sein sollte) und in der Listbox steht nun an erster Stelle eine Null.
Schade...
Anzeige
AW: suchliste
28.12.2016 17:01:34
Hajo_Zi
bei mir nicht. Die Listbox ist gefüllt und die Zelle ist Rot.
Ich habe Karl gesucht.
Gruß Hajo
AW: suchliste
28.12.2016 17:10:16
bassi2008
oh... dann vermute ich, ich habe den code an der falschen Stelle angebracht?
sorry
Ich hatte das so verstanden:

.List(.ListCount - 1, 0) = Cells(rngCell.Row, 1).Interior.Color = 255
.List(.ListCount - 1, 1) = Cells(rngCell.Row, 2)
.List(.ListCount - 1, 2) = Cells(rngCell.Row, 3)
.List(.ListCount - 1, 3) = Cells(rngCell.Row, 4)

bei mir sieht das dann so aus:
Userbild
Anzeige
AW: suchliste
28.12.2016 17:14:38
Hajo_Zi

Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim strFirstAddress As String
With Worksheets("Mitarbeiter").Range("A:D")
Me.ListBox1.Clear
Set rngCell = .Find(Me.TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
Do
With Me.ListBox1
.ColumnCount = 4
.AddItem
.List(.ListCount - 1, 0) = Cells(rngCell.Row, 1)
.List(.ListCount - 1, 1) = Cells(rngCell.Row, 2)
.List(.ListCount - 1, 2) = Cells(rngCell.Row, 3)
.List(.ListCount - 1, 3) = Cells(rngCell.Row, 4)
.ColumnWidths = "2,5cm;1,5cm;2,5cm;2,5cm"
Columns(1).Interior.ColorIndex = xlNone
Cells(rngCell.Row, 1).Interior.Color = 255
End With
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address  strFirstAddress
Else
MsgBox "Abteilung nicht gefunden", 48
End If
End With
End Sub
ich habe kein Programm um aus einem Bild eine Excel Datei mit Code zu machen.
Ich schaue nicht auf fremde Rechner.
Gruß Hajo
Anzeige
Super. Danke :-)
28.12.2016 17:23:36
bassi2008
Hajo, ich danke Dir herzlich.
Tatsächlich hab ich die falsche Stelle anvisiert.
Jetzt klappt es wie angedacht.
Ich denke so komme ich weiter.
Vielen lieben Dank
bassi
hust... doch nochmal :-(
28.12.2016 19:17:23
bassi2008
Hallo liebe Exceler,
zähneknirschend muss ich mangels Wissen doch nochmal nachhaken :-( ich komm einfach nicht drauf so...
Mit dem bisherigen Ablauf wird der gefundene Wert der in der listbox dargestellt wird, in der Tabelle markiert.
Die Suchfunktion ermöglicht es aber z.B. mit einem K* zu suchen.
Nun werden alle Begriffe der Range A:D mit einem K im Wort gelistet.
Soweit so gut...
Die markierung der Zelle erfolgt jetzt aber immer in der letzten gefundenen Zelle. Scheint mir auch logisch.
Aber hier muss ich wohl nachbessern. Das passt so freilich nicht mehr recht.
Also entweder schränke ich die Suchfunktion ein... neeee... oder?
Könnte ich das so machen, dass ich in der Listbox einen Wert markiere und dann mit Klick auf einen Button dieser Wert in der Tabelle markiert/selectiert/aktiviert wird?
Viele Grüße
bassi
Anzeige
AW: hust... doch nochmal :-(
28.12.2016 19:19:52
Hajo_Zi
Du hast schon gesehen das vor der Markierung die Farbe gelöscht wird, darum ist nur einer markiert.
Gruß Hajo
AW: hust... doch nochmal :-(
28.12.2016 19:28:50
bassi2008
Ja Hajo, danke das du nochmal da bist.
Du hast damit freilich auch Recht.
Aber selbst wenn alle gefundenen markiert wären, dann wäre das nicht Zielführend.
Solange nur ein einziges Ergebnis gefunden wird ist es so wie es ist perfekt.
In dem Moment wo mehrere Suchergebnisse zur Verfügung stehen, kann ich aber nicht mehr "automatisch" markieren, da ja nicht bekannt ist, welcher von den gefundenen Bereichen gemeint/gesucht/gefunden werden soll.
Hier sollte der Sucher nocheinmal eine Auswahl treffen (können) und den gewünschten Suchwert anklicken/auswählen können.
Anzeige
hust... doch nochmal :-( ....2.....
28.12.2016 21:40:59
bassi2008
oh... was hab ich denn hier im Forum gebastelt...
Text des Betreff, Ausrufezeichenstatus und Stand der Dinge passen nicht zusammen...
Da hab ich falsch zusammengestellt. Sorry.
So will ich das kurz korrigieren.
An diesem Stand bin ich grad. Über Hilfe wäre ich fürchterlich Dankbar.
----------------------
Solange nur ein einziges Ergebnis gefunden wird ist es so wie es ist perfekt.
In dem Moment wo mehrere Suchergebnisse zur Verfügung stehen, kann ich aber nicht mehr "automatisch" markieren, da ja nicht bekannt ist, welcher von den gefundenen Bereichen gemeint/gesucht/gefunden werden soll.
Hier sollte der Sucher nocheinmal eine Auswahl treffen (können) und den gewünschten Suchwert in der Listbox anklicken/auswählen können, welcher alsdann markiert werden soll.
-------------------
Anbei noch einmal der derzeitige Code

Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim strFirstAddress As String
With Worksheets("Mitarbeiter").Range("A:D")
Me.ListBox1.Clear
Set rngCell = .Find(Me.TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
Do
With Me.ListBox1
.ColumnCount = 4
.AddItem
.List(.ListCount - 1, 0) = Cells(rngCell.Row, 1)
.List(.ListCount - 1, 1) = Cells(rngCell.Row, 2)
.List(.ListCount - 1, 2) = Cells(rngCell.Row, 3)
.List(.ListCount - 1, 3) = Cells(rngCell.Row, 4)
.ColumnWidths = "2,5cm;1,5cm;2,5cm;2,5cm"
Columns(1).Interior.ColorIndex = xlNone
Cells(rngCell.Row, 1).Interior.Color = 255
End With
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address  strFirstAddress
Else
MsgBox "Abteilung nicht gefunden", 48
End If
End With
End Sub

Viele Grüße
bassi
Anzeige
vielleicht so
02.01.2017 13:12:41
Michael
Hi,
versuch's mal so:
Private Sub CommandButton1_Click()
Dim rngCell As Range
Dim strFirstAddress As String
With Worksheets("Mitarbeiter").Range("A:D")
.Columns(1).Interior.ColorIndex = xlNone
Me.ListBox1.Clear
Set rngCell = .Find(Me.TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rngCell Is Nothing Then
strFirstAddress = rngCell.Address
With Me.ListBox1
.ColumnCount = 4
.ColumnWidths = "2,5cm;1,5cm;2,5cm;2,5cm"
End With
Do
With Me.ListBox1
.AddItem
.List(.ListCount - 1, 0) = Cells(rngCell.Row, 1)
.List(.ListCount - 1, 1) = Cells(rngCell.Row, 2)
.List(.ListCount - 1, 2) = Cells(rngCell.Row, 3)
.List(.ListCount - 1, 3) = Cells(rngCell.Row, 4)
End With
.Cells(rngCell.Row, 1).Interior.Color = 255
Set rngCell = .FindNext(rngCell)
Loop While Not rngCell Is Nothing And rngCell.Address  strFirstAddress
Else
MsgBox "Abteilung nicht gefunden", 48
End If
End With
End Sub
Private Sub CommandButton2_Click()
Dim wks As Worksheet
Set wks = Worksheets("Auswahl")
With Me.ListBox1
wks.Range("A2:D2").ClearContents
wks.Range("A2").Value = .List(.ListIndex, 0)
wks.Range("B2").Value = .List(.ListIndex, 1)
wks.Range("C2").Value = .List(.ListIndex, 2)
wks.Range("D2").Value = .List(.ListIndex, 3)
End With
Worksheets("Mitarbeiter").Columns(1).Interior.ColorIndex = xlNone
Unload suche
End Sub
Schöne Grüße,
Michael
Anzeige
AW: vielleicht so
02.01.2017 22:59:13
bassi2008
Michael, einen schönen guten Abend und ein frohes neues Jahr :-)
Jawoll - so ist das perfekt gelöst. Ich bin begeistert. Muss ich gleich umsetzen... die Nacht wird lang ;-)
Ich danke Dir herzlich.
Viele Grüße
bassi
freut mich, beste Grüße zurück owT
03.01.2017 15:55:05
Michael
AW: Super. Danke :-)
28.12.2016 19:30:42
bassi2008
ich hätte mir die Suchfunktion vorher besser anschauen müssen. Dann wäre mir das vorher aufgefallen.
Sorry

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige