Hallöchen,
wie im Namen vielleicht schon erkenbar, habe ich so gar keine Ahnung von VBAs.
Dursch einige Youtube Videos konnte ich gerade eben eine Makro schreiben, die genau das tut was sie soll.
Im nachinein ist mir aufgefallen, dass es an meiner Userfrom noch an etwas mangelt.
Mein wunscht ist es nun durch die Multiselect funktion in Listbox2 die Makierten "Spaleten" zu Addieren und sie mir in eine Textbox "Summe"
anzuzeigen.
Hier einal meine Makro
Private Sub TextBox1_Change()
Dim Zeile As Long
'Listbox Leeren
Me.ListBox1.Clear
'Schleife über eine schleife
For Zeile = 2 To Tabelle6.Cells(Rows.Count, 1).End(xlUp).Row
If InStr(1, LCase(Tabelle6.Cells(Zeile, 5).Value), LCase(Me.TextBox1.Value)) <> 0 Or _
InStr(1, LCase(Tabelle6.Cells(Zeile, 1).Value), LCase(Me.TextBox1.Value)) <> 0 Or _
InStr(1, LCase(Tabelle6.Cells(Zeile, 6).Value), LCase(Me.TextBox1.Value)) <> 0 Then
'Listbox1 füllen
Me.ListBox1.AddItem Tabelle6.Cells(Zeile, 1).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Tabelle6.Cells(Zeile, 2).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Tabelle6.Cells(Zeile, 3).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Tabelle6.Cells(Zeile, 4).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Tabelle6.Cells(Zeile, 5).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Tabelle6.Cells(Zeile, 6).Value
End If
Next Zeile
End Sub
Private Sub TextBox2_Change()
Dim Zeile As Long
Me.ListBox2.Clear
For Zeile = 2 To Tabelle6.Cells(Rows.Count, 10).End(xlUp).Row
If InStr(1, LCase(Tabelle6.Cells(Zeile, 10).Value), LCase(Me.TextBox1.Value)) <> 0 Or _
InStr(1, LCase(Tabelle6.Cells(Zeile, 14).Value), LCase(Me.TextBox1.Value)) <> 0 Or _
InStr(1, LCase(Tabelle6.Cells(Zeile, 15).Value), LCase(Me.TextBox1.Value)) <> 0 Then
'Listbox1 füllen
Me.ListBox2.AddItem Tabelle6.Cells(Zeile, 10).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 1) = Tabelle6.Cells(Zeile, 11).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 2) = Tabelle6.Cells(Zeile, 12).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 3) = Tabelle6.Cells(Zeile, 13).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 4) = Tabelle6.Cells(Zeile, 14).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 5) = Tabelle6.Cells(Zeile, 15).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 6) = Tabelle6.Cells(Zeile, 16).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 7) = Tabelle6.Cells(Zeile, 17).Value
End If
Next Zeile
End Sub
Private Sub UserForm_Initialize()
Dim Zeile As Long
'Schleife über eine schleife
For Zeile = 2 To Tabelle6.Cells(Rows.Count, 1).End(xlUp).Row
'Listbox1 füllen
Me.ListBox1.AddItem Tabelle6.Cells(Zeile, 1).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Tabelle6.Cells(Zeile, 2).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Tabelle6.Cells(Zeile, 3).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Tabelle6.Cells(Zeile, 4).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Tabelle6.Cells(Zeile, 5).Value
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = Tabelle6.Cells(Zeile, 6).Value
Me.ListBox2.AddItem Tabelle6.Cells(Zeile, 10).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 1) = Tabelle6.Cells(Zeile, 11).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 2) = Tabelle6.Cells(Zeile, 12).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 3) = Tabelle6.Cells(Zeile, 13).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 4) = Tabelle6.Cells(Zeile, 14).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 5) = Tabelle6.Cells(Zeile, 15).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 6) = Tabelle6.Cells(Zeile, 16).Value
Me.ListBox2.List(Me.ListBox2.ListCount - 1, 7) = Tabelle6.Cells(Zeile, 17).Value
Me.ListBox2.MultiSelect = fmMultiSelectMulti
Next Zeile
'Erstes Element auswählen
Me.ListBox1.Selected(0) = True
Me.ListBox2.Selected(0) = True
End Sub
Ich hatte an sowas gedacht was ich im Interent gefundne, was ich aber nicht in meine Makro einbauen kann.
Private Sub ListBox1_Change()
Dim lngZeile As Long, lngZeileMax As Long
Me.TextBox1.Value = 0
With Me.ListBox1
lngZeileMax = .ListCount - 1
For lngZeile = 0 To lngZeileMax
If .Selected(lngZeile) = True Then
Me.TextBox1.Value = Me.TextBox1.Value + .List(lngZeile, 3)
End If
Next lngZeile
End With
End Sub
Private Sub UserForm_Initialize()
Dim rngBereich As Range
Dim lngZeichenMax As Long, lngSpalteMax As Long
With Tabelle6
lngZeileMax = .Cells(.Rows.Count, 10).End(xlUp).Row
lngSpalteMax = .Cells(1, .Columns.Count).End(xlUp).Column
Set rngBereich = .Range(.Cells(2, 1), .Cells(lngZeileMax, lngSpalteMax))
Me.ListBox1.List = rngBereich.Value
Me.ListBox1.MultiSelect = fmMultiSelectMulti
End With
End Sub
Schonmal danke für die Hilfe. :)
|