Office: (Office 2010) ListBox Eintrag über Makro auswählen

Hallihallo,

ich habe mal wieder ein Problem.

Folgendes wird in einem Makro gemacht:

Ich habe 3 Listboxen.

In ListBox1 werden bei der initialisierung des Userforms Elemente hinzugefügt. Jedes dieser Elemente besitzt mehrere Elemente, welche in der ListBox2 dargestellt werden sollen. Jedes Element in der ListBox2 besitzt diverse Elemente, welche in der ListBox3 dargestellt werden sollen.

Bei der Initialisierung sollen alle Indizes der Listboxen auf 0 stehen, spricht zunächst werden die Elemente in die ListBox1 importiert und Index 0 gewählt. Dann werden die Elemente zum 0. Element der ListBox1 in die ListBox2 importiert und gleiches bei der ListBox 3.

Für den Import der Elemente für den Eintrag 0 der ListBox2 in die ListBox3 ist mittels ListBox2.Text eine Bedingung notwendig. Leider ist der Wert immer "", also LEER.

Mit ListBox1.Text habe ich das Problem nicht. ListBox3.Text ist wiederum auch "" LEER.

Weiß jmd wieso das so ist und wie ich es beheben kann?

Vielen Dank im Voraus.

Code:

'"Klick auf die ListBox" Ereignisroutine
Private Sub ListBox1_Click()

Dim lZeile As Long      'Laufvariable für Zeile
Dim katnum As Integer   'Kategorienummer
Dim katnumhersteller As Integer 'Kategorienummer des Herstellers
Dim kategoriefragment() As String

'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle "Uebersicht" heraus und tragen die Daten
'in die TextBox ein.
    
'Wir loeschen zunaechst alle bisherigen TextBoxen-Inhalte
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
'Zuerst einmal die Liste leeren
ListBox2.Clear
    
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
    
    lZeile = 6 'Start in Zeile 6, da Zeile 1 bis 5 anderweitig verwendet wird
    'Schleife, welche die Zeile der 1. Spalte solange hochzaehlt, bis eine freie Zeile gefunden wurde
    Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
        
        'Wenn wir den Namen aus der ListBox1 in der 1. Spalte gefunden haben, uebertragen wir die anderen Spalteninhalte in die TextBoxen!
        If (ListBox1.Text = Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) And _
            Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*kategorie*") Then
            
            'TextBoxen fuellen
            TextBox1 = Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value))
                        
            If Not Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value)) = "" Then
                
                katnum = Val(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value)
                
            End If
            
            Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
            
                lZeile = lZeile + 1 'Naechste Zeile bearbeiten
                
                If Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*frei*" Then
                
                    If ListBox2.ListCount > 0 Then ListBox2.ListIndex = 0
                    
                    Exit Sub 'Vorzeitiges Ende, da das Ende der Kategorieliste erreicht ist
                    
                End If
            
                'Splitte die Kategorienummer in Spalte C nach einem "-" in einen einzelnen String und schreibe diese in das Array "Kategoriefragment"
                kategoriefragment = Split(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value, "-")
                katnumhersteller = Val(kategoriefragment(0))
       
                If (Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*hersteller*" And _
                    katnumhersteller = katnum) Then
    
                    'Aktuelle Zeile in die ListBox eintragen
                    ListBox2.AddItem Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value))
                End If
        
            Loop
            
        End If
        
        lZeile = lZeile + 1 'Naechste Zeile bearbeiten
        
    Loop
        
End If
    
End Sub

'"Klick auf die ListBox" Ereignisroutine
Private Sub ListBox2_Click()

Dim lZeile As Long      'Laufvariable für Zeile
Dim katnum As Integer   'Kategorienummer
Dim hernum As Integer   'Herstellernummer
Dim katnumhersteller    'Kategorienummer des Herstellers
Dim hernumartikel As Integer 'Herstellernummer des Artikels
Dim kategoriefragment() As String

'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle "Uebersicht" heraus und tragen die Daten
'in die TextBox ein.
    
'Wir loeschen zunaechst alle bisherigen TextBoxen-Inhalte
TextBox2 = ""
TextBox3 = ""
'Zuerst einmal die Liste leeren
ListBox3.Clear
    
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox2.ListIndex >= 0 Then
    
    lZeile = 6 'Start in Zeile 6, da Zeile 1 bis 5 anderweitig verwendet wird
    'Schleife, welche die Zeile der 1. Spalte solange hochzaehlt, bis eine freie Zeile gefunden wurde
    Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
        
        'Wenn wir den Namen aus der ListBox1 in der 1. Spalte gefunden haben, uebertragen wir die anderen Spalteninhalte in die TextBoxen!
        If (ListBox1.Text = Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) And _
            Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*kategorie*") Then
                        
            If Not Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value)) = "" Then
                
                katnum = Val(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value)
                
            End If
            
            Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
            
                lZeile = lZeile + 1
            
                'Splitte die Kategorienummer in Spalte C nach einem "-" in einen einzelnen String und schreibe diese in das Array "Kategoriefragment"
                kategoriefragment = Split(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value, "-")
                katnumhersteller = Val(kategoriefragment(0))
                
                'Ist die Zeile der ausgewaehlte Hersteller und stimmt die Kategorienummer ueberein
                If (ListBox2.Text = Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) And _
                    Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*hersteller*" And _
                    katnumhersteller = katnum) Then
                    
                    kategoriefragment = Split(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value, "-")
                    hernum = Val(kategoriefragment(1))
                    
                    'TextBoxen fuellen
                    TextBox2 = Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value))
                    
                    Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
                    
                        lZeile = lZeile + 1
                        
                        If (Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*frei*" Or _
                            Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*hersteller*") Then
                    
                            If ListBox3.ListCount > 0 Then ListBox3.ListIndex = 0
                            
                            Exit Sub 'Vorzeitiges Ende, da das Ende der Kategorieliste erreicht ist
                    
                        End If
                    
                        kategoriefragment = Split(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value, "-")
                        hernumartikel = Val(kategoriefragment(1))
                        
                        'Ist die Zeile ein Artikel und stimmt die Herstellernummer ueberein
                        If (Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*artikel*" And _
                            hernumartikel = hernum) Then
                    
                            'Aktuelle Zeile in die ListBox eintragen
                            ListBox3.AddItem Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value))
                        End If
                        
                    Loop
                    
                End If
        
            Loop
            
        End If
        
        lZeile = lZeile + 1 'Naechste Zeile bearbeiten
        
    Loop
        
End If
    
End Sub
'"Klick auf die ListBox" Ereignisroutine
Private Sub ListBox3_Click()

Dim lZeile As Long      'Laufvariable für Zeile
Dim katnum As Integer   'Kategorienummer
Dim hernum As Integer   'Herstellernummer
Dim katnumhersteller    'Kategorienummer des Herstellers
Dim hernumartikel As Integer 'Herstellernummer des Artikels
Dim kategoriefragment() As String

'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle "Uebersicht" heraus und tragen die Daten
'in die TextBox ein.
    
'Wir loeschen zunaechst alle bisherigen TextBoxen-Inhalte
TextBox3 = ""
    
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox3.ListIndex >= 0 Then
    
    lZeile = 6 'Start in Zeile 6, da Zeile 1 bis 5 anderweitig verwendet wird
    'Schleife, welche die Zeile der 1. Spalte solange hochzaehlt, bis eine freie Zeile gefunden wurde
    Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
        
        'Wenn wir den Namen aus der ListBox1 in der 1. Spalte gefunden haben, uebertragen wir die anderen Spalteninhalte in die TextBoxen!
        If (ListBox1.Text = Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) And _
            Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*kategorie*") Then
                        
            If Not Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value)) = "" Then
                
                katnum = Val(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value)
                
            End If
            
            Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
            
                lZeile = lZeile + 1
            
                'Splitte die Kategorienummer in Spalte C nach einem "-" in einen einzelnen String und schreibe diese in das Array "Kategoriefragment"
                kategoriefragment = Split(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value, "-")
                katnumhersteller = Val(kategoriefragment(0))
                
                'Ist die Zeile der ausgewaehlte Hersteller und stimmt die Kategorienummer ueberein
                If (ListBox2.Text = Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) And _
                    Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*hersteller*" And _
                    katnumhersteller = katnum) Then
                    
                    kategoriefragment = Split(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value, "-")
                    hernum = Val(kategoriefragment(1))
                    
                    Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
                    
                        lZeile = lZeile + 1
                        
                        If (Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*frei*" Or _
                            Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*hersteller*") Then
                            
                            Exit Sub 'Vorzeitiges Ende, da das Ende der Kategorieliste erreicht ist
                    
                        End If
                    
                        kategoriefragment = Split(Worksheets(ActiveSheet.Name).Cells(lZeile, 4).Value, "-")
                        hernumartikel = Val(kategoriefragment(1))
                        
                        'Ist die Zeile ein Artikel und stimmt die Herstellernummer ueberein
                        If (ListBox3.Text = Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) And _
                            Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*artikel*" And _
                            hernumartikel = hernum) Then
                    
                            'TextBoxen fuellen
                            TextBox3 = Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value))
                            
                            Exit Sub    'Vorzeitiges Ende, da der Eintrag gefunden wurde
                            
                        End If
                        
                    Loop
                    
                End If
        
            Loop
            
        End If
        
        lZeile = lZeile + 1 'Naechste Zeile bearbeiten
        
    Loop
        
End If
    
End Sub

Private Sub UserForm_Activate()
     'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen
     'jedoch nur, wenn auch Eintraege in der Liste stehen
     If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub

'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()

Dim lZeile As Long
  
'Alle TextBoxen leer machen
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
  
'In dieser Routine laden wir alle vorhandenen Eintraege in die ListBox1
ListBox1.Clear 'Zuerst einmal die Liste leeren
ListBox2.Clear 'Zuerst einmal die Liste leeren
ListBox3.Clear 'Zuerst einmal die Liste leeren
    
lZeile = 6 'Start in Zeile 6, da die Zeile 1 bis 5 anderweitig verwendet wird
'Schleife, welche die Zeile der 1. Spalte solange hochzaehlt, bis eine freie Zeile gefunden wurde
Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
       
    If Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 3).Value)) = "*kategorie*" Then
    
        'Aktuelle Zeile in die ListBox eintragen
        ListBox1.AddItem Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value))
    End If
        
    lZeile = lZeile + 1 'Naechste Zeile bearbeiten
        
Loop
    
End Sub

Was ich auch sehr komisch finde ist, dass es mal geht und dann wieder mal nicht geht. Die gewünschten Elemente sind in den Textboxen scheinbar immer markiert, da blau hinterlegt.

 

Moinsens!

Ich glaube, es wäre besser, wenn Du mal die Mappe mit den Werten hochschickst, die in die List- und Text-Boxen gefüllt werden. Der Aufbau der Tabellen scheint mir, so auf den ersten Blick in den Source, nicht unbedingt so ganz selbsterklärend zu sein. Wie stehen allgmein die Chancen, die Tabellen-Struktur umzustellen?

Ah, und nebenbei:
Worksheets(ActiveSheet.Name)
kannst Du auch abkürzen mit
ActiveSheet

Und wenn Du Trim() benutzt, ist CStr() auch nicht zwingend notwendig. Du kannst also
Do While Trim(CStr(Worksheets(ActiveSheet.Name).Cells(lZeile, 1).Value)) <> ""
prima abkürzen zu
Do While Trim(ActiveSheet.Cells(lZeile, 1).Value) <> ""

Empfehlen würde ich an der Stelle noch, die Blatt-Referenz über eine Variable zu steuern:
Dim s1 as Worksheet
Set s1=Activesheet
[ ... ]
Do While Trim(s1.Cells(lZeile, 1).Value) <> ""

Das ermöglicht dir, einfacher mal das Blatt zu wechseln, wenn die Werte vielleicht doch nicht auf dem ActiveSheet stehen, sondern auf dem Blatt "Werte" z.B.:
Set s1=Worksheets("Werte")

Und wenn die Ergebnisse, also die Werte in den TextBox1..3, nicht ganz das sind, was du erwarten würdest: Setz mal in den Schleifen den Cursor auf die Zelle, die gerade bearbeitet wurde. Nach dem Aktualisieren erkennst Du an der Cursor-Position vielleicht schon, woran es liegt:
Do While Trim(s1.Cells(lZeile, 1).Value) <> ""
s1.cells(lZeile, 1).Activate

Gruß, Michael

 

Ich kann hier nichts hochladen, da bei 100kb Schluss ist.

Danke fürs Anschauen.

http://www.file-upload.net/download-10658454/Material_Bestandliste.xlsm.html

 

Kann mir damit denn keiner helfen? ;(

 

Hallo terry,

zuersteinmal ist mir aufgefallen, dass Du mehrfach die Bildschirmaktualisierung ausschaltest "Application.ScreenUpdating = False", aber nicht ein einziges mal in Deiner Beispielmappe auch wieder einschaltest.
Und eine Fehlerbehandlung, die diese Einstellung wieder zurücksetzt falls das Makro abschmiert fehlt auch.
Obendrein habe ich beim testen festgestellt, das wenn man z.Bsp. Artikel anlegt oder löscht, die Änderung erst sichtbar wird, wenn die UF beendet wird. Das finde ich als User extrem irritierend.
Lass lieber die Finger von Systemeinstellungen, solange Du keinen guten Grund dafür hast, und wirklicht weißt was Du da tust. ;O)


Zu Deinem Eingangspost:
Sry, ich hab versucht mich in Deinen Code einzulesen und hab ihn auch mal im Einzelschrittmodus laufen lassen.
Für mich ist er viel zu unübersichtlich geschrieben, deshalb hab ichs dann wieder sein gelassen.
Ich kann Deinen Fehler also nicht nachvollziehen.


Zu Deiner Tabellenstruktur:
Ich weiß, das viele Programme mit mehrzeiligen Datenstrukturen arbeiten.
Ich persönlich halte in Excel garnix davon, wenn man es irgendwie vermeiden kann.
Das verkompliziert nur alles und macht Probleme.
Überleg doch mal, ob eine Struktur nach diesem Muster:

nicht eventuell eine Alternative für Dich wäre?
Da könnte man viel einfacher und übersichtlicher neu aufbauen.
Aber das ist nur mein persönlicher Geschmack.

 

Moin, terry!

Ich hatte letzte Woche leider nicht mehr so wirklich Zeit, mir das anzusehen, aber ich hatte ja eigentlich auch noch 2 Punkte angemerkt, auf die Du bislang so gar nicht eingegangen bist:

Auf diesen Punkt ist Achim ja auch bereits eingegangen. Wenn ich sehe, daß der Source mit "Ende"-Markern in den Listen arbeitet, hab ich schon gleich ein flaues Gefühl in der Magengegend. Auch wenn Excel nun nicht gerade ein Datenbank-System ist, so kann man doch mit IDs und sVerweis-Formeln schon ein wenig in 1:n-Funktionalität von relationalen Datenbanken gehen. Das bedeutet zwar u.U. eine erhebliche Umstrukturierung, erleichtert aber in der Folge etliches.

Das, ggf. in Verbindung mit einem "Breakpoint" und Anzeigen des "Überwachungen"-Fensters, in dem Du einige Variablen mit ihren aktuellen Werten ausgeben läßt, sollte Dich normalerweise weiter bringen.

Und eine Reduzierung der Daten geht nicht? Ich meine, es muß ja nicht zwingend der komplette Datenbestand sein, wenn der Fehler in einem Teilbereich nachzuvollziehen ist...

Ich schau mal, ob ich heute Abend den externen Download hin bekomme. Hier geht's wegen Proxy-Blockade der Seite nicht.

Gruß, Michael

 

Hallo,

leider weiß ich noch immer nicht, wieso bei einer 2. Checkbox, wo der ListIndex wie bei der ListBox1 auch bei der initialisierung auf 0 gesetzt wird, die Funktion ListBox2.Text manchmal leer ist und manchmal den Wert des Elementes 0 der Box zurück gibt (

Grüße

Terry