Ich habe eine Listbox in einer Userform. Die soll nach bestimmten Kriterien die Werte aus einer Tabelle wiedergeben.
Kriterien:
Min: 180 kg
Max: 1000 kg
Tabelle:
Hersteller Typ min. 0,63 max. 0,63
Noviak 50 x 50 150 1750 <-kg
Noviak 70 x 70 150 2900 <-kg
Noviak 90 x 90 150 5000 <-kg
Noviak 120 x 120 220 5400 <-kg
Noviak 110 x 150 220 6250 <-kg
Noviak 150 x 140 900 9550 <-kg
Marchios 50 x 50 175 1400 <-kg
Marchios 70 x 70 175 2350 <-kg
Marchios 90 x 90 175 4750 <-kg
Mein Lösungsansatz ist folgender, um die Daten erstmals auszufiltern, aber der ist auch Fehler behaftet:
For i = 4 To 100
If Worksheets("Tabellen").Cells(i, 4) <= such1 And Worksheets("Tabellen").Cells(i, 5) >= such2 Then
Worksheets("Tabellen").Cells(i, 4).Select
'Selection.Interior.Color = 255 'rot
'ListBox1.AddItem = Cells(i, 3).Value
'ListBox1.AddItem = Cells(i, 2).Value
End If
Next
Ich habe natürlich eine Bespieldatei angehängt. In der Datei gibt es noch ein Kriterium nach der Geschwindigkeit, aber ich denke wenn ich die Lösungen zum obigen Problem habe, dass ich das dann mit einer simplen If-Bedingung hinbekomme.
With ListBox1
.ColumnCount = 2
.ColumnWidths = "50;50"
.ColumnHeads = False
End With
For i = 4 To letzteZ
If Worksheets("Tabellen").Cells(i, 4) <= such1 Then
For a = 4 To letztea
If Worksheets("Tabellen").Cells(a, 5) <= such2 Then
Worksheets("Tabellen").Cells(a, 4).Interior.Color = 255
Worksheets("Tabellen").Cells(a, 5).Interior.Color = 255
With ListBox1
.ColumnCount = 2
.ColumnWidths = "100;100"
.ColumnHeads = False
End With
For i = 4 To letzteZ
If Worksheets("Tabellen").Cells(i, 4) <= such1 Then
For a = 4 To letztea
If Worksheets("Tabellen").Cells(a, 5) >= such2 Then
'Worksheets("Tabellen").Cells(a, 4).Interior.Color = 255
'Worksheets("Tabellen").Cells(a, 5).Interior.Color = 255
'ListBox1.List(Z, 0) = wks.Cells(a, 2).Value 'Hersteller
'ListBox1.List(Z, 1) = wks.Cells(a, 3).Value 'Typ
ListBox1.AddItem
ListBox1.List(ListBox1.List.Count - 1, 0) = wks.Cells(a, 2).Value
ListBox1.List(ListBox1.List.Count - 1, 1) = wks.Cells(a, 3).Value
End If
Next
End If
Next
Danke jetzt funktioniert es, aber großes Manko ist, das wenn man 5 Ergebnisse hat er die 5 Ergebnisse komplett 5 mal darstellt. Also 25 Ergebnisse anstatt 5.
Kennst da noch eine Lösung für, da ich gar kein Ansatz für habe.
Hallo snb,
dein Code zeigt nur ein Wert an, aber suche ja nach Kriterien. Trotzdem Danke für deine Mühe.
ich blicke da nicht so richtig durch, was Du eigentlich genau machen willst.
Du solltest das hier unbedingt mal in Ruhe durcharbeiten und versuchen, konsequent umzusetzen: Option Explicit, Intellisense und Techniken des Schreibens
Benutze gesetzte Variablen konsequent im weiteren Code. Das vermeidet Fehler, macht den Code schneller und auch besser durchschaubarer.
28.10.2015, 10:51 (Dieser Beitrag wurde zuletzt bearbeitet: 28.10.2015, 11:00 von Joe.)
Hallo Uwe,
Sorry wenn ich unverständlich bin, manchmal seh ich den Wald vor lauter Bäume nicht.
z.B. Kriterium1: 200 [kg]
Kriterium2: 1000 [kg]
Tabelle:
B C D E
4. Hersteller Typ min. Gewicht max. Gewicht
5. Noviak 50 x 50 150 1750
6. Noviak 70 x 70 150 2900
7. Noviak 90 x 90 150 5000
8. Noviak 120 x 120 220 5400
9. Noviak 110 x 150 220 6250
10. Noviak 150 x 140 900 9550
11. Marchios 50 x 50 175 1400
12. Marchios 70 x 70 175 2350
13. Marchios 90 x 90 175 4750
Kriterium1 darf die Spalte min. Gewicht nicht unterschreiten und Kriterium2 darf die Spalte max.Gewicht nicht überschreiten, somit bleibt eine gewisse Auswahl übrig die in der Liste angezeigt werden soll.
Hier mein Code und die Datei. Ich hab versucht alles zu verschöneren (z.B. Option Explicit).
Bin dir sehr Dankbar wenn du mir nochmal helfen kannst.
Code:
Option Explicit
Dim Kriterium1 As Range
Dim Kriterium2 As Range
Dim letzteZeileD As Range
Dim letzteZeileE As Range
Dim wks As Worksheet
Dim i As Byte
Dim a As Byte
Private Sub cmdSuchen_Click()
Kriterium1 = Worksheets("Tabelle1").Range("F13") 'minimal Wert
Kriterium2 = Worksheets("Tabelle1").Range("F15") 'maximal Wert
letzteZeileD = Worksheets("Tabellen").Range("D100").End(xlUp).Row 'gibt die letzte Zeile wieder die nicht leer ist
letzteZeileE = Worksheets("Tabellen").Range("E100").End(xlUp).Row 'gibt die letzte Zeile wieder die nicht leer ist
Set wks = Worksheets("Tabellen")
With ListBox1
.ColumnCount = 2
.ColumnWidths = "100;100"
.ColumnHeads = False
End With
'Leert die ListBox
ListBox1.Clear
For i = 4 To letzteZeileD
If Worksheets("Tabellen").Cells(i, 4) <= Kriterium1 Then
For a = 4 To letzteZeileE
If Worksheets("Tabellen").Cells(a, 5) >= Kriterium2 Then
'Färbt die Zellen die nach den Kriterien passen zur Überprüfung des Codes
Worksheets("Tabellen").Cells(a, 4).Interior.Color = 255
Worksheets("Tabellen").Cells(a, 5).Interior.Color = 255
'Die Liste wird durch die Werte gefüllt die nach den Kriterien passen
