Thema: Problem mit Daten in Listbox | Herbers Excel-Forum

Hallo,
So lasse ich mir in einer Listbox alle Spalten aller Zeilen einer Quelle anzeigen:

Dim wbk As Workbook
   Dim wks As Worksheet
   Dim vRow As Variant
   Dim iRow As Integer, iRowT As Integer, iRowL As Integer
   
   Application.ScreenUpdating = False
   
   Set wbk = Workbooks.Open("F:\daten\mängelliste.xls")

'definieren was gelistet werden soll 
If frmAuftragListe.lbWas = "alle" Then
'Box mit firmen für auswahl füllen START 
'firmenliste.xls ist für gemeinsames bearbeiten freigegeben 
'Dim wbk As Workbook 
   'Dim wks As Worksheet 
   'Dim vRow As Variant 
   'Dim iRow As Integer, iRowT As Integer, iRowL As Integer 
   
   Application.ScreenUpdating = False
   
   'Set wbk = Workbooks.Open("F:\daten\mängelliste.xls") 
   
            Set wks = wbk.Sheets(1)
            With listBmangelliste
               .List = Range("A1").CurrentRegion.Value
               If .ListCount > 0 Then .ListIndex = 0
            End With
         
    wbk.Close savechanges:=False
            
   Set wbk = Nothing
   Set wks = Nothing
   
   Application.ScreenUpdating = True
'Box mit firmen für auswahl füllen Ende 
End If

Jetzt möchte ich mir aber nur bestimmte Zeilen der Quelle anzeigen lassen, allerdings funktioniert mein code nur so, dass zwar alle Zeilen angezeigt werden aber nur eine Spalte.

If frmAuftragListe.lbWas = "VE" Then
'Box mit firmen für auswahl füllen START 
                        On Error Resume Next 'GoTo zError 'muß rein, da er sonst bei sortieren Err weil Liste leer und nix kann man nicht sortieren 
                       iRowL = 0
                       iRowT = 0
                       Set wks = wbk.Sheets(1)
                        iRowL = wks.Cells(wks.Rows.Count, 8).End(xlUp).Row
                        Workbooks.Add
                        'MsgBox "" & iRowL 'Anzahl der Zeilen(Reihen) 
                        
                        For iRow = 1 To iRowL
                         If wks.Cells(iRow, 2).Value = frmAuftrag.lbVE Then
                         vRow = Application.Match(wks.Cells(iRow, 8).Value, Columns(10), 10) '10statt1 
                             If IsError(vRow) Then
                             iRowT = iRowT + 1
                             Cells(iRowT, 1).Value = wks.Cells(iRow, 8).Value
                             End If
                         End If
                         Next iRow
                                                   
                        Range("a1").CurrentRegion.Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlNo
                                               
                        Dim vTemp1  As Variant
                        With wks
                          vTemp1 = Range("A2").CurrentRegion.Value '.Range("A1:H" & .Cells(Rows.Count, 1).End(xlUp).Row) 
                        End With
            
                        With listBmangelliste
                        .List = Range("A1").CurrentRegion.Value 'vTemp1 
                          If .ListCount > 0 Then .ListIndex = 0
                          
                          
                        End With
                        wbk.Close savechanges:=False
'Box mit firmen für auswahl füllen Ende 
End If

Hab schon rumprobiert, kanns aber wieder nicht. Könnt ihr mal bitte schauen.
Viele Grüße aus frostigen Hamburg
Ray

Hallo,
einen . vergessen.
with wks1
vTemp1 = .Range("A2").CurrentRegion.Value
end with
listBmangelliste. List =vTemp1
Gruß
Rudi

Hallo Rudi,
jetzt werden zwar alle Zeilen und Spalten angezeigt, aber es sollen ja nur bestimmte Zeilen angezeigt werden:
For iRow = 1 To iRowL
If wks.Cells(iRow, 2).Value = frmAuftrag.lbVE Then
vRow = Application.Match(wks.Cells(iRow, 8).Value, Columns(10), 10) '10statt1
If IsError(vRow) Then
iRowT = iRowT + 1
Cells(iRowT, 1).Value = wks.Cells(iRow, 8).Value
End If
End If
Next iRow
Range("a1").CurrentRegion.Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlNo
frmAuftrag.lbVE ist Zahl 2. Also nur Zeilen auflisten wo in Spalte B eine 2 steht.
Noch ne Idee?
Grüße aus dem kalten HH
ray

Hallo Ray,
habe mir den 2. Teil des Vba-Codes noch einmal angesehen und es sind einige Ungenauigkeiten aber auch falsche Anweisungen drin.
Mit 'Workbooks.Add' wird eine neue Arbeitsmappe (AM) erstellt. Diese AM ist jetzt die aktive AM und alle Cells/Range-Objektzuweisungen ohne explicite Punktzuweisung [.Cells()/.Range()]beziehen sich auf die 1. Tabelle dieser neuen AM.
1. Ungenauigkeit/Fehler?:
vRow = Application.Match(wks.Cells(iRow, 8).Value, Columns(10), 10)
Columns(10) zeigt nicht auf die 10. Spalte der wks-Tabelle sondern auf die 10. Spalte der ersten Tabelle in der neuen AM
Da in dieser 10. Spalte aber nie was steht, wird immer vRow einen Fehlerwert enthalten.
Frage - was soll diese Codezeile überhaupt machen?
Cells(iRowT, 1).Value = wks.Cells(iRow, 8).Value
Damit wird in die 1. Spalte der 1. Tabelle der neuen AM der Wert aus der 8. Spalte der wks-Tabelle mit der ZeilenNr iRow geschrieben.
Das heißt, es wird immer nur in die 1. Spalte geschrieben.
Bei Cells() kommt zuerst die Zeilen- und dann die Spaltennummer.
2. Ungenauigkeit:
With wks
   vTemp1 = Range("A2").CurrentRegion.Value '.Range("A1:H" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
With wks ist nutzlos, da sich 'Range("A2").CurrentRegion.Value' auf die 1. Tabelle der neuen AM bezieht.
Da in dieser Tabelle nur Spalte A gefüllt ist kannst man in der Listbox auch nur eine Spalte sehen.
Um mit der neu geöffneten AM richtig umzugehen, sollte man hier auch mit Objekt-Variablen arbeiten.
Dim wbNeu As Workbook, wsNeu As Worksheet
Set wkbNeu = Workbooks.Add
Set wksNeu = wkbNeu.Worksheets(1)
Und dann stellt man allen jetzigen Cells()/Range-Objekten ohne Punktzuweisung 'wksNeu.' vorran.
Außerdem hast Du sicher die langsamste Methode gewählt, denn das schreiben vorhandener Daten in eine neue Tabelle in einer neuen AM, um diese dann in eine Listbox anzuteigen, ist nicht gerade schnell. Außerdem wird diese neue AM nie geschlossen und deshalb werden sich mit der Zeit neu geöffnete AM's ansammeln - immer dann, wenn sich der Wert in 'frmAuftragListe.lbWas' ändert.
Du siehst, es ist noch viel zu tun, aber ich helfe Dir auch gern weiter.
Gruß von Luschi
aus klein-Paris