UF Listbox o. leere Zeilen wenn Wert in Sp B

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Private arrListe(), lngIndex As Long Private Sub cmd_Schließen_Click() Unload Me End Sub Private Sub UserForm_Initialize() Dim wks As Worksheet Set wks = Worksheets("Tabelle1") lngIndex = 0 Erase arrListe With wks '1. Bereich Call ListeFuellen(rngBereich:=.Range(.Cells(10, 1), .Cells(.Rows.Count, 1).End(xlUp).Offset( _ 0, 3))) ' Call ListeFuellen(rngBereich:=.Range(.Cells(10, 1), .Cells(250, 4))) '2. Bereich Call ListeFuellen(rngBereich:=.Range(.Cells(10, 6), .Cells(.Rows.Count, 6).End(xlUp).Offset( _ 0, 3))) '3. Bereich Call ListeFuellen(rngBereich:=.Range(.Cells(10, 11), .Cells(.Rows.Count, 11).End(xlUp). _ Offset(0, 3))) End With With Me.ListBox1 .ColumnCount = 4 .Font.Size = 11 .ColumnWidths = "150pt;60pt;100pt;100pt" .List = Application.WorksheetFunction.Transpose(arrListe) End With Erase arrListe End Sub Sub ListeFuellen(rngBereich As Range) Dim Zeile As Long, Spalte As Long For Zeile = 1 To rngBereich.Rows.Count If rngBereich.Cells(Zeile, 2) = 0 Or rngBereich.Cells(Zeile, 2) = "" Then Else lngIndex = lngIndex + 1 ReDim Preserve arrListe(1 To 4, 1 To lngIndex) For Spalte = 1 To 4 arrListe(Spalte, lngIndex) = rngBereich.Cells(Zeile, Spalte) Next End If Next End Sub

Hallo Franz,
ich bin restlos begeistert. Funktioniert einwandfrei!
Werde mich mit dem Code mal näher auseinandersetzen. Ich habe hier in dem Forum zwar schon viel gelernt, aber mein Aktiv-Know-How reicht leider für solche Aufgaben bei weitem noch nicht aus.
Deshalb nochmals ganz herlichen Dank, dass Du Dir die Mühe gemacht hast und mir eine fertig Lösung präsentierst, die ich in mein Projekts übernehmen kann.
Es ist immer ein schönes Gefühl, wenn ich eine Idee habe, dann stundenlang recherchiere und probiere und dann schlussendlich doch hier im Forum nachfrage und ... dann prompt solche tolle Lösungen bekomme!
Ich weiß ja nicht welche Rolle du hier im Forum spielst, aber es ist ja auch von Dir nicht der 1. Tolle Tipp für mich. Grüß die Mannschaft mal von mir. Tolle Truppe :-)
Ich wünsche Dir noch einen schönen 1. Mai
Viele Grüße
Dietmar

Option Explicit Private arrListe(), lngIndex As Long Private Sub cmd_Schließen_UF_Produkte_Click() Unload Me End Sub Private Sub UserForm_Initialize() Dim wks As Worksheet Set wks = Worksheets("Verkauf_") lngIndex = 0 Erase arrListe With wks 'NUR noch ein Bereich: Call ListeFuellen(rngBereich:=.Range(.Cells(200, 1), .Cells(400, 5))) End With With Me.ListBox1 .ColumnCount = 6 .Font.Size = 10 .ColumnWidths = "170pt;60pt;65pt;80pt;100pt;80pt" .List = Application.WorksheetFunction.Transpose(arrListe) '

Hallo Dietmar,
zu 1.) nur 1 Eintrag in Liste, Darstellung in 1 Spalte
Dieses Phänomen tritt leider auf. Gleiche Frage gab es hier gestern auch schon. Lösung über AddItem-Methode
zu 2.) keine Einträge gefunden
Dann ist das Array, das die Listbox füllen soll, noch darnicht dimensioniert - da gib es den VBA-GAU. Über Prüfung des Arrray-Zählers lngIndex auf Werte 0, 1 und sonstige kann man das Problem umschiffen.
zu 3.) Währungsformat in Listbox
Hier muss beim Einlesen die Spalte auf 4 oder 5 geprüft werden und dann entweder die Text-Eigenschaft eingelesen werden oder der Zellinhalt entsprechend formatiert in die Liste geschrieben werden.
Gruß
Franz

Option Explicit
Private arrListe(), lngIndex As Long
Private Sub cmd_Schließen_UF_Produkte_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim wks As Worksheet
Dim Spalte As Integer
Set wks = Worksheets("Verkauf_")
lngIndex = 0
Erase arrListe
With wks
'NUR noch ein Bereich:
Call ListeFuellen(rngBereich:=.Range(.Cells(200, 1), .Cells(400, 5)))
End With
With Me.ListBox1
.ColumnCount = 6
.Font.Size = 10
.ColumnWidths = "170pt;60pt;65pt;80pt;100pt;80pt"
.Clear
Select Case lngIndex
Case 0
'do nothing
MsgBox "Keine Einträge für Listbox gefunden", vbInformation + vbOKCancel, "Listbox fü _
llen"
Case 1
.AddItem arrListe(1, 1)
For Spalte = 1 To 5
.List(0, Spalte) = arrListe(Spalte + 1, 1)
Next
Case Else
.List = Application.WorksheetFunction.Transpose(arrListe)
End Select
End With
Erase arrListe
End Sub
Sub ListeFuellen(rngBereich As Range)
Dim Zeile As Long, Spalte As Long
For Zeile = 1 To rngBereich.Rows.Count
If rngBereich.Cells(Zeile, 3) = 0 Or rngBereich.Cells(Zeile, 3) = "" Then
Else
lngIndex = lngIndex + 1
ReDim Preserve arrListe(1 To 6, 1 To lngIndex)
For Spalte = 1 To 6
Select Case Spalte
Case 4, 5
'arrListe(Spalte, lngIndex) = rngBereich.Cells(Zeile, Spalte).Text 'Anzeige wie in  _
Tabelle formatiert
arrListe(Spalte, lngIndex) = Format(rngBereich.Cells(Zeile, Spalte), "#,##0.00 ")
Case Else
arrListe(Spalte, lngIndex) = rngBereich.Cells(Zeile, Spalte)
End Select
Next
End If
Next
End Sub

Beliebteste Forumthreads (12 Monate)

UF Listbox o. leere Zeilen wenn Wert in Sp B

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

UF Listbox o. leere Zeilen wenn Wert in Sp B

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread