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, 11:51 (Dieser Beitrag wurde zuletzt bearbeitet: 28.10.2015, 12: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
