Supportnet / Forum / Tabellenkalkulation
Werte aus Datenfeld in Listbox übertragen
Frage
Hallo liebe Mitexceler,
ich bin am Erstellen eines Suchmakros. Ich will in einem beliebigen Datenblatt über ein Userform in dem Datenblatt "Kunden" anhand einer Teilstringsuche Kundennummern ausfindig machen. Hierzu wird über ein Userform der Teilstring abgefragt und nun sollen in dem Userform alle Zeilen angegeben werden, welche diesen Teilstring enthalten.
Ich möchte Werte aus 5 Spalten dieser Zeilen in fünf Spalten des Userforms übertragen. Ich habe Excel 2000.
Hier mein Code:
' Listfeld über Datenfeld
Sub FundstellenSuchen()
Application.ScreenUpdating = False
Dim rQuelle, rAusgangszelle, rAusgangssheet As Range
Dim Gefunden()
Dim i, sFundstellen As Integer
Dim sSuche As String
i = 0
sFundstellen = -1
rAusganszelle = ActiveCell.Address
rAusganssheet = ActiveSheet.Name
sSuche = InputBox("Suche nach?", "Suchfenster Kundennummer")
For Each rQuelle In Worksheets("Kunden").Range("B:B")
If InStr(rQuelle, sSuche) > 0 Then sFundstellen = sFundstellen + 1
Next rQuelle
For Each rQuelle In Worksheets("Kunden").Range("B:B")
If InStr(rQuelle, sSuche) > 0 Then
For i = 0 To sFundstellen
ReDim Preserve Gefunden(0 To sFundstellen, 0 To 4)
Gefunden(i, 0) = rQuelle.Offset(0, -1)
Gefunden(i, 1) = rQuelle.Value
Gefunden(i, 2) = rQuelle.Offset(0, 1)
Gefunden(i, 3) = rQuelle.Offset(0, 5)
Gefunden(i, 4) = rQuelle.Offset(0, 6)
UserForm2.ListBox1.ColumnCount = 5
UserForm2.ListBox1.List(i, 0) = Gefunden(i, 0)
UserForm2.ListBox1.List(i, 1) = Gefunden(i, 1)
UserForm2.ListBox1.List(i, 2) = Gefunden(i, 2)
UserForm2.ListBox1.List(i, 3) = Gefunden(i, 3)
UserForm2.ListBox1.List(i, 4) = Gefunden(i, 4)
Next i
End If
Next rQuelle
UserForm2.Show
End Sub
Der Code bricht in der Zeile
" UserForm2.ListBox1.List(i, 0) = Gefunden(i, 0)"
mit der Meldung
"Eingeschaft List konnte nicht abgerufen werden"
ab.
Hier kommt Ihr ins Spiel - Hilfe und vielen Dank schon mal im Voraus.
Euer Eleve
Antwort 1 von M.O.
Hallo Eleve,
eine Listbox wird mit dem Befehl
Gruß
M.O.
eine Listbox wird mit dem Befehl
AddItem
gefüllt. Also ersetze mal List
durch AddItem
.Gruß
M.O.
Antwort 2 von aiuto
Hallo Eleve,
In Deinem Code haben sich mehrere Fehler eingeschlichen.
Habe versucht Dein Anliegen umzusetzen - versuchs 'mal so:
mfg
vom Helfer
In Deinem Code haben sich mehrere Fehler eingeschlichen.
Habe versucht Dein Anliegen umzusetzen - versuchs 'mal so:
Option Explicit
Sub FundstellenSuchen()
Application.ScreenUpdating = False
Dim rQuelle, rAusgangszelle, rAusgangssheet
Dim Gefunden()
Dim i, sFundstellen As Integer
Dim sSuche As String
i = 0
sFundstellen = -1
rAusgangszelle = ActiveCell.Address
rAusgangssheet = ActiveSheet.Name
sSuche = InputBox("Suche nach?", "Suchfenster Kundennummer")
UserForm2.ListBox1.Clear
UserForm2.ListBox1.ColumnCount = 5
For Each rQuelle In Worksheets("Kunden").Range("B1:B" & Range("B65536").End(xlUp).Row)
If InStr(rQuelle, sSuche) > 0 Then sFundstellen = sFundstellen + 1
Next rQuelle
ReDim Preserve Gefunden(sFundstellen, 4)
For Each rQuelle In Worksheets("Kunden").Range("B1:B" & Range("B65536").End(xlUp).Row)
If InStr(rQuelle, sSuche) > 0 Then
Gefunden(i, 0) = rQuelle.Offset(0, -1)
Gefunden(i, 1) = rQuelle.Value
Gefunden(i, 2) = rQuelle.Offset(0, 1)
Gefunden(i, 3) = rQuelle.Offset(0, 5)
Gefunden(i, 4) = rQuelle.Offset(0, 6)
i = i + 1
End If
Next rQuelle
UserForm2.ListBox1.List = Gefunden()
UserForm2.Show
End Sub
mfg
vom Helfer
Antwort 3 von aiuto
@M.O.
mfg
vom Helfer
Zitat:
eine Listbox wird mit dem Befehl
AddItem
gefüllt.
Also ersetze mal
List
durch
AddItem
stimmt so also schon 'mal garnicht!eine Listbox wird mit dem Befehl
AddItem
gefüllt.
Also ersetze mal
List
durch
AddItem
mfg
vom Helfer
Antwort 4 von coros
Hallo aiuto,
bevor Du hier den Mund sehr voll nimmst und andere verbesserst, solltest Du vorher erst mal prüfen, ob das was Du schreibst auch stimmt. Eine Listboxx kann man sehr wohl mit der .AddItem Methode füllen.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
bevor Du hier den Mund sehr voll nimmst und andere verbesserst, solltest Du vorher erst mal prüfen, ob das was Du schreibst auch stimmt. Eine Listboxx kann man sehr wohl mit der .AddItem Methode füllen.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 5 von aiuto
Hi Oliver,
.AddItem
das kann man sehr wohl - muß man aber nicht unbedingt.
Es gibt darüber hinaus noch mehrere Methoden, eine Listbox zu füllen. Nichts Anderes habe ich ("den Mund sehr voll nimmst") behauptet.
Im Übrigen war die Frage des Threadopeners
Ich werde mich hier mit Dir nicht anlegen, zumal Du für mich DER unangefochtene Excel-VBA-Pabst bist, dennoch führen viele Wege nach Rom.
mfg
vom Helfer
.AddItem
das kann man sehr wohl - muß man aber nicht unbedingt.
Es gibt darüber hinaus noch mehrere Methoden, eine Listbox zu füllen. Nichts Anderes habe ich ("den Mund sehr voll nimmst") behauptet.
Im Übrigen war die Frage des Threadopeners
Zitat:
{b]Werte aus Datenfeld in Listbox übertragen
, relativ eindeutig, und dazu ist die .AddItem - Methode im obigen Beispielcode eben nicht geeignet.{b]Werte aus Datenfeld in Listbox übertragen
Ich werde mich hier mit Dir nicht anlegen, zumal Du für mich DER unangefochtene Excel-VBA-Pabst bist, dennoch führen viele Wege nach Rom.
mfg
vom Helfer
Antwort 6 von Eleve
Hallo an alle Helfer und besonders an Helfer,
vielen Dank erst mal für die rege Diskussion.
Ich habe Deinen Code getestet, Helfer,
leider wird in der Zeile
" If InStr(rQuelle, sSuche) > 0 Then sFundstellen = sFundstellen + 1"
sFundstellen nicht raufgezählt und im Anschluss bricht das Makro ab.
Hier mein Ausgangsmakor welches funktioniert, mir aber die Ergebnisse nicht in Spalten schreibt - was ziemlich unübersichtlich ist.
' ist Makro der Wahl
Sub FundstellenSuchen2()
Application.ScreenUpdating = False
Dim rQuelle, rAusgangszelle, rAusgangssheet As Range
Dim Gefunden()
Dim i As Integer
Dim sSuche As String
'i = 0
rAusganszelle = ActiveCell.Address
rAusganssheet = ActiveSheet.Name
sSuche = InputBox("Suche nach?", "Suchfenster Kundennummer")
For Each rQuelle In Worksheets("Kunden").Range("B:B")
If InStr(rQuelle, sSuche) > 0 Then
ReDim Preserve Gefunden(i)
Gefunden(i) = rQuelle.Offset(0, -1) & " " & rQuelle.Value & " " & rQuelle.Offset(0, 1) & " " & rQuelle.Offset(0, 5) & " " & rQuelle.Offset(0, 6)
UserForm2.ListBox1.List = Gefunden
i = i + 1
End If
Next rQuelle
UserForm2.Show
End Sub
Noch eine Bitte, wer kann mir sagen, wie ich diese Nachrichten so formatieren kann, wie das bei Euch aussieht?
Schönen Grüße, evtl. schönen Feierabend oder frohes Schaffen
Eleve
vielen Dank erst mal für die rege Diskussion.
Ich habe Deinen Code getestet, Helfer,
leider wird in der Zeile
" If InStr(rQuelle, sSuche) > 0 Then sFundstellen = sFundstellen + 1"
sFundstellen nicht raufgezählt und im Anschluss bricht das Makro ab.
Hier mein Ausgangsmakor welches funktioniert, mir aber die Ergebnisse nicht in Spalten schreibt - was ziemlich unübersichtlich ist.
' ist Makro der Wahl
Sub FundstellenSuchen2()
Application.ScreenUpdating = False
Dim rQuelle, rAusgangszelle, rAusgangssheet As Range
Dim Gefunden()
Dim i As Integer
Dim sSuche As String
'i = 0
rAusganszelle = ActiveCell.Address
rAusganssheet = ActiveSheet.Name
sSuche = InputBox("Suche nach?", "Suchfenster Kundennummer")
For Each rQuelle In Worksheets("Kunden").Range("B:B")
If InStr(rQuelle, sSuche) > 0 Then
ReDim Preserve Gefunden(i)
Gefunden(i) = rQuelle.Offset(0, -1) & " " & rQuelle.Value & " " & rQuelle.Offset(0, 1) & " " & rQuelle.Offset(0, 5) & " " & rQuelle.Offset(0, 6)
UserForm2.ListBox1.List = Gefunden
i = i + 1
End If
Next rQuelle
UserForm2.Show
End Sub
Noch eine Bitte, wer kann mir sagen, wie ich diese Nachrichten so formatieren kann, wie das bei Euch aussieht?
Schönen Grüße, evtl. schönen Feierabend oder frohes Schaffen
Eleve
Antwort 7 von aiuto
Hallo Eleve,
Warum versuchst Du nicht einmal meinen Code? Habe ihn getestet.
TIP: Benutze immer "Option Explicite" - weil
Btw wenn Du immer die ganZe Spalte B:B durchsuchen läßt wird das Suchen auch nur unnötig langsam.
mfg
vom Helfer
Warum versuchst Du nicht einmal meinen Code? Habe ihn getestet.
TIP: Benutze immer "Option Explicite" - weil
Zitat:
Dim rQuelle, rAusgangszelle, rAusgangssheet As Range
rAusganszelle = ActiveCell.Address
rAusganssheet = ActiveSheet.Name
sind zwei paar ganS verschiedene Stiefel.;-)Dim rQuelle, rAusgangszelle, rAusgangssheet As Range
- und
rAusganszelle = ActiveCell.Address
rAusganssheet = ActiveSheet.Name
Btw wenn Du immer die ganZe Spalte B:B durchsuchen läßt wird das Suchen auch nur unnötig langsam.
mfg
vom Helfer
Antwort 8 von Eleve
Hallo Helfer,
Option Explicit - ok - ist mir peinlich, seh ich ein ;-).
Leider funzt Dein Code bei mir nicht.
Der Code bleibt in der Zeile:
ReDim Preserve Gefunden(sFundstellen, 4)
mit der Fehlermeldung
"Laufzeitfehler 9, Index außerhalb dem gültigen Bereich"
hängen.
So wie ich das sehe wird der Wert von sFundstellen nicht von -1 auf 0 gesetzt.
Was die Spalte B angeht hast Du auch recht, geht ziemlich langsam.
Aber zum lernen bin ich ja hier...
schöne Grüße
Eleve
Option Explicit - ok - ist mir peinlich, seh ich ein ;-).
Leider funzt Dein Code bei mir nicht.
Der Code bleibt in der Zeile:
ReDim Preserve Gefunden(sFundstellen, 4)
mit der Fehlermeldung
"Laufzeitfehler 9, Index außerhalb dem gültigen Bereich"
hängen.
So wie ich das sehe wird der Wert von sFundstellen nicht von -1 auf 0 gesetzt.
Was die Spalte B angeht hast Du auch recht, geht ziemlich langsam.
Aber zum lernen bin ich ja hier...
schöne Grüße
Eleve
Antwort 9 von Eleve
Hallo Helfer,
ich hab den Fehler gefunden. Der code läuft nur wenn ich das
Sheet Kunden aktiviere. Ich musste auch noch den sFundstellenzähler an das Ende der for..next Schleife umstellen.
Aber nun läufts wie gewünscht.
Vielen Dank lieber Helfer, Du hast Deinem Namen alle Ehre gemacht.
hier noch der geänderte Code, falls jemand Verwendung dafür hat.
ich hab den Fehler gefunden. Der code läuft nur wenn ich das
Sheet Kunden aktiviere. Ich musste auch noch den sFundstellenzähler an das Ende der for..next Schleife umstellen.
Aber nun läufts wie gewünscht.
Vielen Dank lieber Helfer, Du hast Deinem Namen alle Ehre gemacht.
hier noch der geänderte Code, falls jemand Verwendung dafür hat.
Option Explicit
Sub FundstellenSuchen()
Application.ScreenUpdating = False
Dim rQuelle, rAusgangszelle, rAusgangssheet
Dim Gefunden()
Dim i, sFundstellen As Integer
Dim sSuche As String
i = 0
sFundstellen = 0
rAusgangszelle = ActiveCell.Address
rAusgangssheet = ActiveSheet.Name
sSuche = InputBox("Suche nach?", "Suchfenster Kundennummer")
UserForm2.ListBox1.Clear
UserForm2.ListBox1.ColumnCount = 5
Worksheets("Kunden").Activate
For Each rQuelle In Worksheets("Kunden").Range("B1:B" & Range("B65536").End(xlUp).Row)
If InStr(rQuelle, sSuche) > 0 Then sFundstellen = sFundstellen + 1
Next rQuelle
ReDim Preserve Gefunden(sFundstellen, 4)
For Each rQuelle In Worksheets("Kunden").Range("B1:B" & Range("B65536").End(xlUp).Row)
If InStr(rQuelle, sSuche) > 0 Then
Gefunden(i, 0) = rQuelle.Offset(0, -1)
Gefunden(i, 1) = rQuelle.Value
Gefunden(i, 2) = rQuelle.Offset(0, 1)
Gefunden(i, 3) = rQuelle.Offset(0, 5)
Gefunden(i, 4) = rQuelle.Offset(0, 6)
i = i + 1
sFundstellen = sFundstellen + 1
End If
Next rQuelle
Worksheets(rAusgangssheet).Activate
Range(rAusgangszelle).Activate
UserForm2.ListBox1.List = Gefunden()
UserForm2.Show
End Sub