Bessere Lösung als SUMMENPRODUKT möglich?

[Gast 123]

Hallo Ralf,

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
 
  '******************************************************
 
  'neue Zeile einfügen
  Rows(2).EntireRow.Insert
 
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
 
Fehler:  MsgBox Error()
End Sub

[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

   TextBox1 = Format(Date, "dd\.mm\.yyyy")
End Sub

[Gast 123]

Hallo snb

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)

mfg  Gast 123

[snb]

Wen man .List verwendet um ein Listbox zu befüllen ist .clear immer überflüssig.

Bitter verstehe mich nicht falsch, ich habe nur gemeint deine VBA Wissens zu erweiteren. :100:

[snb]

Schau mal:

[Elguano]

Guten Abend Gast123 und snb

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.

[Gast 123]

Hallo Ralf

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!

mfg  Gast 123

[Gast 123]

Hallo Ralf

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!

 Me("ListBox" & j).List = Application.Index(sn, Choose(j - 2, [row(1:20)], [row(21:40)], [row(41:60)], [row(61:80)]), 1)

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.

mfg  Gast 123

[snb]

@El G

Die angehängte Datei war für Gast 123, nicht für dich.

Bitte bleibe im Bleistift Stadium.

[Elguano]

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.