dein Wunsch ist kein Thema, es war nur zwei Minuten Arbeit. Wenn man sein Programm kennt, und weiss wo man eingreifen muss, kannman es leicht veraendern. Ich habe jetzt auch die versprochene Prüfung mit eingebaut, falls mal jemand mehr als 10 Kunden in den ListBoxen anklickt. Dann wird die Eingabe verweigert. Teste es bitte selbst.
Zum technischen, damit du VBA lernst und versteht. Im Eigabe Makro gibt es zwei getrennte Bereiche. Einen für Einzelauswertung, einen für mehrfach Auswertung. Im Prinzip habe ich bei der mehrfach ASW nur den Befehl -neue Zeiele einfügen- direkt an den Anfang gestellt, und das weitere Einfügen in den For Next Schleifen gelöscht. So simpel wars.
Eine Erweiterung von Fahrern, Kunden und kunden-Spalten ist auch kein Thema. Sollte problemlos funktionieren. Sollte es noch Rückfragen geben stehe ich euch zur Verfügung. Mich freut ja selbst das es mir gelungen ist diese Aufgabe so gut zu lösen. Gibt mir nnere Befriedigung, wenn es gut klappt.
mfg Gast 123
Code:
Option Explicit '6.3.2017 Clever Forum Gast 123 'geändert: 9.3.2017 mehrfach Eingabe ohne neue Zeile Dim EG As Worksheet, AC As Object Dim LS As Worksheet, Rfd As Object Dim Fahrer As String, Datum As Date Dim Heute As Date
Sub Button_UF_zeigen() UserForm1.Show End Sub
'Neues Programm als Multiselect 'mit vier ListBoxen für Kunden
Sub Werte_eintragen_Multiselect() Dim Kunde As String, ID2 As Integer Dim ms3, ms4, ms5, ms6, ms, j, lz Dim Indx1, Indx2, col, sp, rw, Txt Set EG = Worksheets("Eingaben") Set LS = Worksheets("Listen")
'On Error GoTo Fehler With UserForm1 'Variable aus ListBox1 laden Indx1 = .ListBox1.ListIndex Indx2 = .ListBox2.ListIndex Datum = CDate(.TextBox1) sp = 3 '1.Spalte Kunde A-J
If Indx1 = -1 Then MsgBox "Kein Fahrer ausgewählt": Exit Sub
If Indx1 >= 0 Then Fahrer = .ListBox1.Value If Indx2 >= 0 Then Txt = .ListBox2.Value
'Vorprüfung - Eingabe in Kunde A-J ?? col = EG.Range("C1").End(xlToRight).Column - 2 For Each AC In EG.Range("C1").Resize(1, col) If Txt = "" Then ID2 = Empty: Exit For If AC.Value = Txt Then ID2 = AC.Column Next AC
'Vorprüfung - auf Multiselect Eingabe For j = 0 To .ListBox3.ListCount - 1 If .ListBox3.Selected(j) = True Then ms3 = ms3 + 1: Txt = .ListBox3.List(j) & " /3-" & j If .ListBox4.Selected(j) = True Then ms4 = ms4 + 1: Txt = .ListBox3.List(j) & " /4-" & j If .ListBox5.Selected(j) = True Then ms5 = ms5 + 1: Txt = .ListBox3.List(j) & " /5-" & j Next j For j = 0 To .ListBox6.ListCount - 1 If .ListBox6.Selected(j) = True Then ms6 = ms6 + 1: Txt = .ListBox3.List(j) & " /6-" & j Next j ms = ms3 + ms4 + ms5 + ms6
'Aussprung wenn eine Eingabe fehlt If ms = 0 Then MsgBox "Kein Kunde ausgewählt (ListBox 3-6)": Exit Sub If ms = 1 And ID2 = 0 Then MsgBox "Kunde A-J nicht ausgewählt": Exit Sub If ms > col Then MsgBox "Es wurden mehr als " & col & " Kunden angeklickt! Eingabe nicht zulässig!!": Exit Sub
'Einzelauswertung über Kunde A-J If ms = 1 And ID2 > 0 Then 'neue Zeile einfügen (verschieben) Rows(2).EntireRow.Insert Kunde = Left(Txt, InStr(Txt, "/") - 1) 'Datum, Kunde und Fahrer einfügen Cells(2, 1).Value = Datum Cells(2, 2).Value = Fahrer Cells(2, ID2).Value = Kunde 'Kunde A-J Eintrag löschen ID2 = .ListBox2.ListIndex .ListBox2.RemoveItem ID2 .ListBox2.ListIndex = -1 On Error Resume Next rw = Worksheets("Listen").Range("E2").End(xlDown).Row 'Kunden Eintrag löschen (LB 3-6) For j = 0 To Int(rw / 4) + 4 If .ListBox3.Selected(j) = True Then .ListBox3.RemoveItem j: Exit Sub If .ListBox4.Selected(j) = True Then .ListBox4.RemoveItem j: Exit Sub If .ListBox5.Selected(j) = True Then .ListBox5.RemoveItem j: Exit Sub If .ListBox6.Selected(j) = True Then .ListBox6.RemoveItem j: Exit Sub Next j Exit Sub 'ASW Ende End If
m3: 'Multiselect Auswertung über Fahrer If ms3 > 0 Then For j = 0 To .ListBox3.ListCount If .ListBox3.Selected(j) = True Then Kunde = .ListBox3.List(j) 'Datum, Kunde und Fahrer einfügen Cells(2, 1).Value = Datum Cells(2, 2).Value = Fahrer Cells(2, sp).Value = Kunde sp = sp + 1 'Kunde A-J 'Kunde + Kunde A-J löschen .ListBox2.RemoveItem 0 .ListBox3.RemoveItem j GoSub clrKunde 'Clr Kunde ms3 = ms3 - 1: GoTo m3 End If Next j End If
m4: 'Multiselect ListBox4 If ms4 > 0 Then For j = 0 To .ListBox4.ListCount If .ListBox4.Selected(j) = True Then Kunde = .ListBox4.List(j) 'Datum, Kunde und Fahrer einfügen Cells(2, 1).Value = Datum Cells(2, 2).Value = Fahrer Cells(2, sp).Value = Kunde sp = sp + 1 'Kunde A-J 'Kunde + Kunde A-J löschen .ListBox2.RemoveItem 0 .ListBox4.RemoveItem j GoSub clrKunde 'Clr Kunde ms4 = ms4 - 1: GoTo m4 End If Next j End If
m5: 'Multiselect ListBox5 If ms5 > 0 Then For j = 0 To .ListBox5.ListCount If .ListBox5.Selected(j) = True Then Kunde = .ListBox5.List(j) 'Datum, Kunde und Fahrer einfügen Cells(2, 1).Value = Datum Cells(2, 2).Value = Fahrer Cells(2, sp).Value = Kunde sp = sp + 1 'Kunde A-J 'Kunde + Kunde A-J löschen .ListBox2.RemoveItem 0 .ListBox5.RemoveItem j GoSub clrKunde 'Clr Kunde ms5 = ms5 - 1: GoTo m5 End If Next j End If
m6: 'Multiselect ListBox6 If ms6 > 0 Then For j = 0 To .ListBox6.ListCount If .ListBox6.Selected(j) = True Then Kunde = .ListBox6.List(j) 'Datum, Kunde und Fahrer einfügen Cells(2, 1).Value = Datum Cells(2, 2).Value = Fahrer Cells(2, sp).Value = Kunde sp = sp + 1 'Kunde A-J 'Kunde + Kunde A-J löschen .ListBox2.RemoveItem 0 .ListBox6.RemoveItem j GoSub clrKunde 'Clr Kunde ms6 = ms6 - 1: GoTo m6 End If Next j End If
'Fahrer + ListBox Indexe löschen '** .ListBox1.ListIndex = -1 'Fahrer .ListBox1.RemoveItem Indx1 'Fahrer löschen .ListBox1.ListIndex = -1 'Fahrer .ListBox2.ListIndex = -1 'Kunde A-J End With Exit Sub
clrKunde: 'Tages-Kunden löschen (noch oben verschieben) 'Kunden bei Datumwechsel kopieren (TagesKunden) Set Rfd = LS.Columns("G:G").Find(What:=Kunde, After:=Range("G1"), _ LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext) If Not Rfd Is Nothing Then Rfd.Delete Shift:=xlUp Return
10.03.2017, 13:09 (Dieser Beitrag wurde zuletzt bearbeitet: 10.03.2017, 13:09 von snb.)
@Gast
nur zum Lernen: wie weniger Variabelen, desto einfacher.
Code:
Private Sub Workbook_Open() '*** Diese Demo Zeile für den Normalbetrieb löschen !!! MsgBox "Auto Open zur Demo der Tages-Kunden deaktiviert" Exit Sub
'Kunden bei Datumwechsel kopieren (TagesKunden) With Sheets("Listen").Range("G2:G500") If Sheets("Eingaben").Cells(2, 1) <> Date Then .Value = .Offset(, -2).Value End With End Sub
Dieze Sätze sind überflüssig, denn die Listboxes/combobox sind immer leer wenn das Userform geladen wird.
Code:
Private Sub UserForm_Initialize() With UserForm1 On Error GoTo Fehler UserForm1.ListBox1.Clear UserForm1.ListBox2.Clear UserForm1.ListBox3.Clear UserForm1.ListBox4.Clear UserForm1.ListBox5.Clear UserForm1.ListBox6.Clear
Userform1 Referenzieren ist üerflüssig, wiel die Code sich im Codemoduls des Userforms befindet.
Deine ganze Initialize event könnte so aussehen:
Code:
Private Sub UserForm_Initialize() ListBox1.List = Sheets("Listen").Columns(1).SpecialCells(2).Offset(1).SpecialCells(2).Value ListBox2.List = Application.Transpose(Sheets("eingaben").Rows(1).SpecialCells(2).Offset(, 2).SpecialCells(2).Value)
sn = Sheets("Listen").Columns(7).SpecialCells(2).Offset(1).SpecialCells(2).Resize(80) For j = 3 To 6 Me("ListBox" & j).List = Application.Index(sn, Choose(j - 2, [row(1:20)], [row(21:40)], [row(41:60)], [row(61:80)]), 1) Next
es mag richtig sein das in meinem Code vielleicht nicht alles Optimal ist, das ich die UserForm lösche hat seinen Sinn. An einer anderen Stelle rufe ich über einenCommandButton die Initialisierung der UserForm bei geöffneter UserForm wieder auf. Wenn die alten Daten nicht gelöscht werden hat man Müll in der ListBox, weil alte Restdaten stehen bleiben und neue AddItem dazukommen. Den Effekt hatte ich ja in der Praxis!!
Ich haette das Löschen auch in den CommandButton verlegen können, entschied mich aber es doch lieber es in der Initial Routine auszuführen. Ich habe ja in der 1. Makro Version alle ListBox Eintraege die abgearbeitet waren gelöscht, um auf Wunsch von Ralf versehentliche Doppeleingaben zu vermeiden. Der Nachteil war das für nachtraegliche Einzelbearbeitung die Fahrer, Kunden, und Kunden A-J gelöscht waren. Deshalb habe ich ja die Labels über den ListBoxen durch Button ersetzt, damit man Original Daten wieder zurückladen kann.
Vielleicht kann man mein Makro noch verbessern, ich habe nbichts dagegeben! Nur bitte aufpassen das alle Funktionen, die ich ja durch Versuch und Irtum verbessern musste, auch so wie vom Frager gewünscht ablaufen. Wer das besser programmieren kann, von mir aus.
Was sagtst du dennn zu dem Gesamtkonzept meiner Lösung?? Da steckt ja eine Menge probieren, tüffteln, verbessern, und auf die Wünsche von Ralf eingehen drin. Die gesamte Idee mit UserForm stammt ja aus meiner Feder. Wiederum verbessert von Ralf, der sie auf 4 Kunden ListBoxen erweitert hat. Ich sehe das als gelungene Zusammenarbeit an.
Das es Kollegen gibt die über noch bessere Programmier Wissen verfügen wie ich habe ich immer akzeptiert. Mein Markenzeichen ist es an solche Aufgaben heranzugehen, und möglichst Komplettlösungen anzubieten. Gegen Verbesseruıngen habe ich nichts einzuwenden. (sie sollten nur so laufen wie Ralf es sich wünscht)
Dieses Thema ist es nicht Wert sich zu Streiten. Ich habe auch nichts gegen jegliche Verbesserungen. Konstruktive Kritik kann wohl jeder Vertragen und sollte auch niemand etwas dagegen haben. Aber das sollte man dann doch schon so machen, das man was damit anfangen kann.
Lieber snb Ich habe mir Deine angehängte Datei einmal runtergeladen und geöffnet. Ergebnis: Nichts passiert ausser einer Fehlermeldung das das Macro deaktiviert wurde. Das ist ja dann wohl eine eher schlechte Verbesserung. Ich habe nicht genug Fachwissen um diesen Fehler zu beseitigen. Was soll denn in Deiner Datei besser sein oder mir einfacher machen? (bzw meinem Auftraggeber) Eine Codeumstellung nur weil etwas nicht gebraucht wird halte ich nicht unbedingt für eine Verbesserung, wenn dann garnichts mehr geht. Du kannst Dich aus der Nummer nur rausbringen, wenn Du eine Datei anhängst, die auch funktioniert. Ganz ehrlich gesagt: Da war mir die erste Datei von Gast123 10 mal lieber auch wenn die noch verbesserungsbedürftig war. Aber Sie hat wenigstens funktioniert.
Schöne Grüße und fabelhaftes Wochenende Ralf B. aus B. an der E.
PS.: Leider hat mein Auftraggeber nur auf der Arbeit Excel. Deshalb kann er die Datei erst nächste Woche ausprobieren.
sorry, hier muss ich snb sogar in Schutz nehmen, diese MsgBox Meldung stammt von mir und muss im normalen Betrieb gelöscht werden.
Begründung: Beim Öffnen der Datei wird im Modul "Diese Arbeitsmappe" der Befehl "Open" ausgeführt, d.h., beim Öffnen der Datei prüfe ich ob der Tag gewechselt hat, dann kopiere ich alle Kunden in die Nachbarspalte für "Tages-Kunden". In dieser Spalte werden alle Kunden die an dem Tag gebucht wurden gelöscht. Ich musste dafür aber eine Hilfsspalte nehmen, weil ich jka nicht den Original Datensatz löschen darf. Du erkennst es daran, das beim laden der ListBoxen 3-6 einmal der ganze Kundensatz geladen wird, oder nur die -verbleibenden Kunden- des aktuellen Tages.
snb hat mit der Deaktivierung nichts zu tun, ich vergass dir das mitzuteilen! Du must bitte in das Modul "Diese Arbeitsmappe" gehen und die Zeile für die MsgBox und den Befehl danach "Exit Sub" einfach löschen. Dann ist die Auto_open Funktion bei jedem Öffnen aktiv.
Die Datei von snb werde ich mir noch in Ruhe ansehen, habe im Augenblick aber private Anliegen die vorgehen.. Probiert das ganze bitte in Ruhe aus. Die Befehlszeile kannst du auch in der Datei von snb löschen, und beide Dateien vergleichen. Welche zum Einsatz kommt ist deine Entscheidung. Mir bleibt aber der bescheidene Stolz diese Aufgabe durch meinen Einsatz überhaupt soweit gebracht zu haben, das kann mir keiner nehmen!
ich habe noch einmal eine neue Beispieldatei hochgeladen, weil mir beim Testen der Datei von snb ein Denk-Fehler in meinem Programm aufgefallen ist. Schön das ich ihn noch abfangen konnte, bevor er beim Auftraggeber aufgetreten waere. Ein herzliches Dankeschön dafür an snb.
Ich gebe offen zu das sein Wissen weit über meins hinausgeht. Da kann ich nur sagen Hut ab, ich habe den Code noch nicht verstanden! Alleerdings dürfte es Anfaengern nicht möglich sein es überhaupt zu verstehen! Das UserForm Programm von snb ist technisch moderner wie meine Version, ich habe es im Augenblick bei meinem Programm belassen, u.a. wegen dieser Zeile: sie ist zwar moderner, aber in der Form mit einem eklatanten Nachteil!
Hiermit können nur genau 80 Kunden in die ListBoxen geladen werden, verteilt auf die fest definierten Zeilen 1:20, 21:40 usw. Was ist wenn es einmal 85, 90, 100 Kunden sind? Dann klappt seine Initialisierung nicht mehr. Sorry snb
Ich weise die Kollegen höflich darauf hin das ihr euch meistens an die konkrete Aufgabenstellung haltet. Sie wie es geschrieben steht! Als alter Praktiker habe ich mir nicht ohnen Grund Gedankengemacht: Was ist wenn sich die Anzahl der Fahrer, der Kunden oder Kunden pro Tag veraendert?? Denn das ist doch die normale Praxis draussen. Man entwickelt eine Tabelle, und dann kommen neue Personen dazu. Verbunden mit der :Frage: funktioniert jetzt mein Makro immer noch einwandfrei?? Oder gibt es den Geist auf und produziert Müll, weil der Range Bereich nicht mehr stimmt!!
Ich kann auch nicht alles vorhershen, versuche aber so universal zu sein, das sich das Makro soweit wie möglich von selbst anpasst. Und dumme Fehler beim Entwickeln gibt es nun mal. Niemand ist unfehlbar, dann korrigiert man sie eben.
Guten Abend Gast123 Ich habe mir die letzte Datei von Dir angeschaut. Wenn ich mich nicht vertan habe, ist jetzt alles so wie ich mir das vorgestellt habe.
Jetzt werden auch alle Kunden in eine Zeile geschrieben. So ist das Perfekt. Darauf kannst Du stolz sein. Wenn Du denkst, dass ich von snb irgendetwas nehmen würde, hast Du Dich in mir getäuscht. Leuten die sich erst nicht beteiligen, aus welchen gründen auch immer, dann plötzlich aus dem nichts auftauchen und den Helfenden zurechtweisen wollen, und dann noch beleidigende Antworten schreiben, können mir gestohlen bleiben. Der kann meinetwegen auf seinem hohen ross hinreiten wohin Er will. In Themen die ich anfange braucht Er sich nicht mehr sehen zu lassen. Seine Antworten oder Meinung interessiert mich nicht im geringsten.
Allen anderen und insbesondere Dir, danke ich vielmals für die Unterstützung.
Ich wünsche Euch alles gute und ein schönes Wochenende Ralf B. aus B. an der E.
