AW: Listbox füllen ohne Leerzellen
13.04.2016 14:45:20
ChrisL
Hi Robby
Ich muss ja nicht alles verstehen...
Mit nachstehenden Codezeilen verabschiede ich mich dann auch, da ich irgendwann auch meine Brötchen verdienen muss.
Private Sub CommandButton5_Click()
Worksheets("Stundenplan").Range("B1:F33").ClearContents
Call AllesUebernehmen(ListBox1)
Call AllesUebernehmen(ListBox2)
Call AllesUebernehmen(ListBox3)
Call AllesUebernehmen(ListBox4)
Call AllesUebernehmen(ListBox5)
End Sub
Private Sub AllesUebernehmen(LB)
If LB.ListIndex > -1 Then
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, iCounter As Long
Dim tempSpalte1 As Integer, tempSpalte2 As Integer
Set WS1 = Worksheets("K2")
Set WS2 = Worksheets("Stundenplan")
tempSpalte1 = Application.Match(LB.List(LB.ListIndex), WS1.Rows(1), 0)
tempSpalte2 = WS2.Range("I1").End(xlToLeft).Column + 1
WS2.Cells(1, tempSpalte2) = LB.List(LB.ListIndex)
For iZeile = 2 To WS1.Cells(WS1.Rows.Count, tempSpalte1).End(xlUp).Row
If WS1.Cells(iZeile, tempSpalte1) <> "" Then
iCounter = iCounter + 1
WS2.Cells(iCounter + 1, tempSpalte2) = WS1.Cells(iZeile, tempSpalte1)
End If
Next iZeile
End If
End Sub
Private Sub ListBox6_Change()
Call AuswahlUebernehmen(ListBox1, ListBox6)
End Sub
Private Sub ListBox7_Change()
Call AuswahlUebernehmen(ListBox2, ListBox7)
End Sub
Private Sub ListBox8_Change()
Call AuswahlUebernehmen(ListBox3, ListBox8)
End Sub
Private Sub ListBox9_Change()
Call AuswahlUebernehmen(ListBox4, ListBox9)
End Sub
Private Sub ListBox10_Change()
Call AuswahlUebernehmen(ListBox5, ListBox10)
End Sub
Private Sub AuswahlUebernehmen(LB1, LB2)
Dim tempSpalte As Integer, i As Long
With Worksheets("Stundenplan")
If WorksheetFunction.CountIf(.Rows(1), LB1.List(LB1.ListIndex)) = 0 Then
tempSpalte = .Range("I1").End(xlToLeft).Column + 1
.Cells(1, tempSpalte) = LB1.List(LB1.ListIndex)
Else
tempSpalte = Application.Match(LB1.List(LB1.ListIndex), .Rows(1), 0)
End If
.Range(.Cells(2, tempSpalte), .Cells(33, tempSpalte)).ClearContents
For i = 0 To LB2.ListCount - 1
If LB2.Selected(i) = True Then _
.Cells(33, tempSpalte).End(xlUp).Offset(1, 0) = LB2.List(i)
Next i
End With
End Sub
cu
Chris