Multiselect ListBox und Rechnen

Private Sub ListBox_Produkt_Click() Dim i As Integer Application.ScreenUpdating = False For i = 2 To Sheets("Lagerbestand").Range("B65536").End(xlUp).Row If ListBox_Produkt.Text = Sheets("Lagerbestand").Cells(i, 2) Then TextBox_Wert.Value = Sheets("Lagerbestand").Cells(i, 1) Exit For End If Next End Sub

Private Sub UserForm_Initialize() ComboBox_Kategorie.List = Sheets("Kategorie").Range("A1", "A" & Sheets("Lagerbestand").Range(" _ A65536").End(xlUp).Row).Value Kasse.TextBox_Datum.Value = Date Kasse.TextBox_Login.Value = Application.UserName Kasse.TextBox_Menge.Value = "1" End Sub

Private Sub Command_speichern_Click() Worksheets("Kasse").Activate Dim i As Integer Dim last As Integer last = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1 ActiveSheet.Cells(last, 2).Value = Kasse.TextBox_Datum.Value ActiveSheet.Cells(last, 3).Value = Kasse.TextBox_Login.Value ActiveSheet.Cells(last, 4).Value = Kasse.ListBox_Produkt.Value ActiveSheet.Cells(last, 5).Value = Kasse.Label8.Caption.Value ActiveSheet.Cells(last, 6).Value = Kasse.TextBox_Käufer.Value MsgBox "Gespeichert" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Peter,
Danke das du dich meldest.
Leider kann ich keine Mappe Hochladen hoffe meine Beschreibung reicht aus.
Tabelle 1 Worksheet.Kasse
Spalte A : Kalenderwoche(einfache ISO)
Spalte B : Datum
Spalte C : Verkäufer
Spalte D : Produkt
Spalte E : Käufer
Spalte F : Gesamtkosten
Die Tabelle ist die Haupttabelle dort wird durch das Userform alles eingetragen.
Tabelle 2 Worksheet.Lagerbestand
Spalte A :Der Wert des einzelnen Produkts
Spalte B :Das Produkt selbst
Spalte C :Die Kategorie des Produkts
Spalte D :Der Lagerbestand
Spalte E :Der Bestand vor Ort
Hier holt sich das Userform die Informationen der Werte von Spalte A durch Anklicken in der Listbox die mit dem Produkt verbunden ist. (funktioniert auch) Nur das Automatisch der Lagerbestand hier weniger wird nach erfolgtem eintrag in Tabelle 1 geht noch nicht.
Tabelle 3 Worksheet.Kategorie
Nur Spalte A damit die ComboBox gefüllt wird.
Da bekommt die ComboBox ihre werte her die per select alle Produkte dieser Kategorie in der Listbox anzeigen. (funktioniert auch)
Nun möchte ich noch den komplette UserForm Code reinstellen. Naja nicht komplett das was funktioniert.


Private Sub UserForm_Initialize()
Dim wert As Integer
Dim i As Integer
Dim iZeile As Integer
Dim vUebArr(15, 1) As Variant
Dim iAnz As Integer
Dim last As Integer
ComboBox_Kategorie.List = Sheets("Kategorie").Range("A1", "A" & Sheets("Lagerbestand").Range(" _
A65536").End(xlUp).Row).Value
Kasse.TextBox_Datum.Value = Date
Kasse.TextBox_Login.Value = Application.UserName
Kasse.TextBox_Menge.Value = "1"
End Sub

Private Sub ComboBox_Kategorie_Change()
Dim iZeile As Integer
Dim vUebArr(15, 1) As Variant
Dim iAnz As Integer
For iZeile = 1 To Sheets("Lagerbestand").Range("B65536").End(xlUp).Row
If Sheets("Lagerbestand").Cells(iZeile, 3).Value = ComboBox_Kategorie.Text Then
vUebArr(iAnz, 0) = Sheets("Lagerbestand").Range("B" & iZeile).Value
vUebArr(iAnz, 1) = Sheets("Lagerbestand").Range("C" & iZeile).Value
iAnz = iAnz + 1
End If
Next iZeile
ListBox_Produkt.List = vUebArr
End Sub

Private Sub Command_löschen_Click()
Kasse.TextBox_Käufer.Value = ""
ListBox_Produkt.Value = ""
ComboBox_Kategorie.Value = ""
End Sub

Private Sub Command_schliessen_Click()
Unload Kasse
End Sub

Private Sub Command_speichern_Click()
Worksheets("Kasse").Activate
Dim i As Integer
Dim last As Integer
last = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
ActiveSheet.Cells(last, 2).Value = Kasse.TextBox_Datum.Value
ActiveSheet.Cells(last, 3).Value = Kasse.TextBox_Login.Value
ActiveSheet.Cells(last, 4).Value = Kasse.ListBox_Produkt.Value
ActiveSheet.Cells(last, 5).Value = Kasse.Label8.Caption
ActiveSheet.Cells(last, 6).Value = Kasse.TextBox_Käufer.Value
MsgBox "Gespeichert"
End Sub

Private Sub Label8_Click()
Label8.Caption = CDbl(TextBox_Menge.Value) * CDbl(TextBox_Wert.Value)
End Sub

Private Sub ListBox_Produkt_Click()
Application.ScreenUpdating = False
For i = 2 To Sheets("Lagerbestand").Range("B65536").End(xlUp).Row
If ListBox_Produkt.Text = Sheets("Lagerbestand").Cells(i, 2) Then
TextBox_Wert.Value = Sheets("Lagerbestand").Cells(i, 1)
Exit For
End If
Next
End Sub

Das Userform kann ich auch noch optimieren wenn ein Command Button erforderlich ist
Momentan hat es 5 Textbox (4 für die Eingabe davon einer in dem ich Menge eingebe und eine Textbox wo nur der Einzelwert ausgegeben wird.) Die Caption liefert den Gesamtbetrag.
Dann hat es den Speichern, Löschen und Schließen command_button
Ich hoffe du kannst mir helfen.

Option Explicit Private Function BinarySearch(ByRef source As Variant, ByVal target As Variant) As Long Dim low As Long Dim high As Long Dim mid As Variant low = LBound(source, 1) high = UBound(source, 1) While low 0 Err.Clear On Error GoTo 0 End Function Private Function GetColumn(ByRef shTable As Worksheet, ByVal columnIndex As Long) As Variant If shTable Is Nothing Then Exit Function Dim lastRow As Long With shTable lastRow = .Cells(.Rows.count, columnIndex).End(xlUp).Row GetColumn = .Range(.Cells(1, columnIndex), .Cells(lastRow, columnIndex)).Value End With End Function Private Function GetSelected(ByRef ListControl As MSForms.ListBox) As Variant Dim i As Long Dim itemSel() As Variant Dim count As Long With ListControl For i = 0 To .ListCount - 1 If .selected(i) = True Then ReDim Preserve itemSel(count) itemSel(count) = .List(i, 0) count = count + 1 End If Next i End With GetSelected = itemSel End Function Private Sub CommandButton1_Click() Dim selections As Variant Dim vData1 As Variant Dim vData2 As Variant selections = GetSelected(Me.ListBox1) If EmptyArray(selections) Then Exit Sub vData1 = GetColumn(ThisWorkbook.Sheets("Tabelle1"), 1) vData2 = GetColumn(ThisWorkbook.Sheets("Tabelle1"), 2) With ThisWorkbook.Sheets("Tabelle1") On Error Resume Next Label1.Caption = .Cells(BinarySearch(vData1, selections(0)), 2).Value * CLng(TextBox4. _ Value) Label2.Caption = .Cells(BinarySearch(vData1, selections(1)), 2).Value * CLng(TextBox5. _ Value) Label3.Caption = .Cells(BinarySearch(vData1, selections(2)), 2).Value * CLng(TextBox6. _ Value) End With End Sub Private Sub ListBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As _ Single, ByVal Y As Single) Dim i As Long Dim amountSel As Long Const MAX_AMOUNT = 3 If Button = 1 Then For i = 0 To ListBox1.ListCount - 1 If ListBox1.selected(i) = True Then amountSel = amountSel + 1 If amountSel = MAX_AMOUNT Then ListBox1.selected(i) = False End If End If Next i End If End Sub Private Sub UserForm_Initialize() ListBox1.List = GetColumn(ThisWorkbook.Sheets("Tabelle1"), 1) End Sub

Hallo Peter,
Absolut spitze, da erkennt man das ich noch Anfänger bin.
Auf die Möglichkeit von Funktionen kam ich gar nicht. Natürlich musste ich den Code etwas umschreiben.
Ich habe nun auch noch ein zusätzlichen Command Button integriert für die Berechnung.
Wenn es dir keine Arbeit macht, sonst versuche ich das irgendwie jetzt selbst zu lösen.
Du hast bei deinem Userform 3 Labels die jeweils den Gesamtbetrag berechnen. Ich habe aber nur 2 Labels. Das eine Label aktualisiert sich automatisch sobald man auf ein produkt klickt und zeigt den Wert des Produkts an, das man zuvor angeklickt hat. Nun in der Textbox die Menge des Produkt eingeben und auf ok (1. Command Button) klicken. Bei dir ist es berechnen. Bei mir soll es ein zwischenspeichern sein.
Jedoch wirdbei dir GesamtWert in einem dazugehörigen Label angezeigt. Dadurch hast du 3 und auch 3* Textboxen, auch hier habe ich nur eine Mengen Textbox.
Bei mir wird dieser Wert NICHT angezeigt, sondern soll irgendwo gemerkt werden.
Klickt man nun auf ein weiteres Produkt wird das erste und einzige Label sofort aktualisiert mit dem neuen Wert.(ohne das man ok oder berechnen etc klicken muss) Der erste GesamtWert vom ersten Produkt soll sich das Programm aber merken durch den OK Button. Das Spiel geht solange, bis kein weiteres Produkt dazukommt (maximal 9 Verschiedene, Durchschnitt liegt bei 4). Am Ende drücke ich auf Berechnen(den neu erstellten Button) und der Gesamtwert aller errechneten also gemerkten Werten wird im 2 Label angezeigt und in meine Tabelle mit allen Daten gespeichert. Was zum Schluss in Label 1 Steht ist irrelevant, werde das dann clearen was aber nur schönheit ist.
Es muss also nur der Gesamtwert gespeichert werden.
Wie gesagt, nur wenn du zeit hast, dann wäre ich endlich fertig und lernen tue ich dadurch auch. Das habe ich durch dich nämlich ganz gut schon.
Danke dir Peter, war echt am verzweifeln. Und die aussage das du mir nicht helfen kannst und konntest habe ich somit entkräftet.
Dennoch habe jetzt auch die Tabelle mit dem Userform ohne Werte hinzugefügt. Nur damit du ein Überblick hast. Ich verstehe das es so viel einfacher ist.
https://www.herber.de/bbs/user/121896.xlsm

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Multiselect ListBox und Rechnen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread