Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1576to1580
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
Suchfunktion mit 2 Kriterien
05.09.2017 14:12:58
Sarah
Hallo Zusammen,
ich arbeite erst seit ein paar Tagen mit VBA.
Nun habe ich eine Suchfunktion, mit der ich eine Lieferantenliste durchsuchen kann. Allerdings möchte ich nun bei der Suche das nicht nur nach einem Suchbegriff gesucht wird, sondern mir nur die Ergebnisse angezeigt werden, wo der Status in der Spalte "O" = 1 ist.
Über Hilfe würde ich mich sehr freuen.
Private Sub CommandButton1_Click()   '  Suchen
Dim Lieferanten As Workbook, Bereich As Range
Set Lieferanten = Workbooks.Open("Mein Workbook")
ThisWorkbook.Windows(1).Visible = False
Dim rng As Range
Dim strFirst As String
Dim vtmp() As Long
Dim tntC As Integer
If Len(Trim(TextBox13)) = 0 Then Exit Sub
ListBox1.Clear
For IntC = 1 To 11
Controls("TextBox" & IntC) = ""
Next
ReDim vtmp(0)
With Sheets("Stammdaten")
Set rng = .Range("B:B").Find(What:=TextBox13, Lookat:=xlPart)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If Not (IsNumeric(Application.Match(rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = rng.Row
ListBox1.AddItem .Cells(rng.Row, 3)
ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(rng.Row, 4)
ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(rng.Row, 7)
ListBox1.List(ListBox1.ListCount - 1, 3) = .Cells(rng.Row, 2)
ListBox1.List(ListBox1.ListCount - 1, 4) = rng.Row
End If
Set rng = .Range("B:B").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address  strFirst
End If
End With
If ListBox1.ListCount > 0 Then
ListBox1.ListIndex = 0
Else
ListBox1.AddItem "Kein Eintrag!"
End If
Set rng = Nothing
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchfunktion mit 2 Kriterien
05.09.2017 14:20:44
Werner
Hallo Sarah,
das sollte doch gehen, wenn du vor einlesen der Daten in die ListBox die Zelle in Spalte O auf den Wert 1 abfragst.
In diesem Bereich dann:
Do
If Not (IsNumeric(Application.Match(Rng.Row, vtmp, 0))) Then
ReDim Preserve vtmp(UBound(vtmp) + 1)
vtmp(UBound(vtmp)) = Rng.Row
If .Cells(Rng.Row, 15) = 1 Then
ListBox1.AddItem .Cells(Rng.Row, 3)
ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(Rng.Row, 4)
ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(Rng.Row, 7)
ListBox1.List(ListBox1.ListCount - 1, 3) = .Cells(Rng.Row, 2)
ListBox1.List(ListBox1.ListCount - 1, 4) = Rng.Row
End If
End If
Set Rng = .Range("B:B").FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address  strFirst
Gruß Werner
Anzeige
AW: Suchfunktion mit 2 Kriterien
05.09.2017 15:05:17
Sarah
Vielen lieben Dank, das funktioniert bestens :)
Und mein Rechner ist nicht abgestürzt wie bei der If-Abfrage die ich vorhin getestet habe
Gerne u. Danke für die Rückmeldung. o.w.T.
05.09.2017 15:32:51
Werner
AW: Suchfunktion mit 2 Kriterien -> Autofilter
05.09.2017 15:07:32
Daniel
Hi
setze den Autofilter auf die Spalte B für deinen Suchbegriff und den Filter für die Spalte O nach 1 und lass die Schleife dann über alle sichtbaren Zellen laufen:
With Sheets("Stammdaten").Cells(1, 1).CurrentRegion
.Autofilter field:=2, Criteria1:="*" & Textbox13.Text & "*"
.Autofilter Field:=15, Criteria1:="1"
for each rng in .columns(1).Specialcells(xlcelltypevisible)
if rng.row > 1 '--- Zeile1  = Überschrift
With Listbox1
.AddItem rng.offset(0, 2).value
.List(.ListCount - 1, 1) = rng.offset(0, 3).value
.List(.ListCount - 1, 2) = rng.offset(0, 6).value
.List(.ListCount - 1, 3) = rng.offset(0, 1).value
.List(.ListCount - 1, 4) = rng.row
end with
end if
next
.Autofilter
end with
Gruß Daniel
Anzeige

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige