Makro zum vergleichen und verschieben von Werten

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Makro zum vergleichen und verschieben von Werten
von: René Schönberg
Geschrieben am: 17.04.2015 22:07:06

Moin zusammen,
ich bin neu hier, also verzeiht mir bitte eventuelle Fehler...
Ich bin auf der Suche nach einem Makro mit dem ich die eingetragenen Werte in dem Tabellenblatt1 Spalte B mit allen Werten in den Tabellenblättern2 & 3 vergleichen kann. Hierbei gibt es schon das erste Problem die werte müssen zwei Bedingungen erfüllen. In der Spalte A muss z.Bsp. "S2" stehen und in der Spalte C muss "i.o" stehen. Erst wenn diesebeiden Bedingungen erfüllt sind darf der Wert verglichen werden. Wenn es keine Übereinstimmung gibt, soll der Wert in das Tabellenblatt4 Zelle B6 kopiert werden. Ich benötige das Makro um die Formel die ich bisher verwende abzulösen, da diese meine Liste extrem langsam macht. Hier mal die Formel damit ihr versteht wie das Makro arbeiten soll
{=WENNFEHLER(INDEX(Prüfliste!$B:$B;MIN(WENN(ISTNV(VERGLEICH(Prüfliste!$B$3:$B$3991; Ausgeliefert!$D$1:$D$4000;))*ISTNV(VERGLEICH(Prüfliste!$B$3:$B$3991;Auslieferung!$E$6:$E$43;)) *ISTNV(VERGLEICH(Prüfliste!$B$3:$B$3991;$E$5:$E7;))*(Prüfliste!$C$3:$C$3991="i.o") *(Prüfliste!$A$3:$A$3991="S5");ZEILE(Prüfliste!$3:$3991))));"") } diese Formel steht z.Bsp. in E8. Im Moment steht diese Formel in jeder Zelle in dem Bereich von B6 bis E21, natürlich entsprechend der Bedingungen leicht abgewandelt. Und darum könnt ihr euch sicher vorstellen warum ich auf ein Makro zurückgreifen möchte. :)
Soweit bin ich schon gekommen:

Sub Kopieren()
Dim rng As Range
For Each rng In Sheets("Prüfliste").Range("B3:B" & Range("B65536").End(xlUp).Row)
   If Sheets("Auslieferung").Range("G3") >= 1 Then
   End If
Sheets("Auslieferung").Range("A6") = "Satz 1"
   If Sheets("Prüfliste").Cells(rng.Row, 2) <> Sheets("Ausgeliefert").Cells(Rows.Count, 1) And  _
_
      Sheets("Prüfliste").Cells(rng.Row, 1) = "S2" And _
      Sheets("Prüfliste").Cells(rng.Row, 3) = "i.o" Then
     
      Sheets("Prüfliste").Cells(rng.Row, 2).Copy _
      Destination:=Sheets("Auslieferung").Cells(6, 2)
      End If
      Next rng
      
For Each rng In Sheets("Prüfliste").Range("B3:B" & Range("B65536").End(xlUp).Row)
  If Sheets("Prüfliste").Cells(rng.Row, 2) <> Sheets("Ausgeliefert").Cells(Rows.Count, 2) And _
      Sheets("Prüfliste").Cells(rng.Row, 1) = "S3" And _
      Sheets("Prüfliste").Cells(rng.Row, 3) = "i.o" Then
      Sheets("Prüfliste").Cells(rng.Row, 2).Copy _
      Destination:=Sheets("Auslieferung").Cells(6, 3)
End If
Next rng
For Each rng In Sheets("Prüfliste").Range("B3:B" & Range("B65536").End(xlUp).Row)
    If Sheets("Prüfliste").Cells(rng.Row, 2) <> Sheets("Ausgeliefert").Cells(Rows.Count, 3).End( _
xlUp).Row And _
      Sheets("Prüfliste").Cells(rng.Row, 1) = "S4" And _
      Sheets("Prüfliste").Cells(rng.Row, 3) = "i.o" Then
      Sheets("Prüfliste").Cells(rng.Row, 2).Copy _
      Destination:=Sheets("Auslieferung").Cells(6, 4)
End If
Next rng
For Each rng In Sheets("Prüfliste").Range("B3:B" & Range("B65536").End(xlUp).Row)
     If Sheets("Prüfliste").Cells(rng.Row, 2) <> Sheets("Ausgeliefert").Cells(Rows.Count, 4). _
End(xlUp).Row And _
      Sheets("Prüfliste").Cells(rng.Row, 1) = "S5" And _
      Sheets("Prüfliste").Cells(rng.Row, 3) = "i.o" Then
      Sheets("Prüfliste").Cells(rng.Row, 2).Copy _
      Destination:=Sheets("Auslieferung").Cells(6, 5)
End If
Next rng
End Sub

allerings bezieht dieses Makro nicht alle Vergleichswerte mit ein und bekomme ich auch Nummern die schon vergeben sind raus.
Vielen Dank im voraus!!!

Bild

Betrifft: AW: Makro zum vergleichen und verschieben von Werten
von: Michael
Geschrieben am: 17.04.2015 23:35:16
Hallo René,
ohne mich genau eingelesen zu haben:
Bei derartigen Datenmengen finde ich es einfach sinnvoll, die Tabelle zu sortieren.
Bei geschickter Wahl der Sortierkriterien (und evlt. Einführung einer Hilfsspalte) hast Du ziemlich viele der gesuchten Daten direkt hintereinander.
Man kann die Daten zum Sortieren zunächst in ein dafür reserviertes Blatt kopieren (damit die originalen Daten nicht beeinträchtigt werden) und von dort aus arbeiten.
Weiter in die Tiefe mag ich erst mal nicht gehen, denn die vorgestellten Makros kommen mir einigermaßen irrwitzig vor. Um *vier* Zellen (Sheets("Auslieferung").Cells(6, [2 bis 5]) zu füllen, viermal den kompletten Datenbestand durchzurödeln, kann es nicht sein.
Versuch doch bitte mal, das Problem in eine handliche Beispieltabelle zu verfrachten und hochzuladen.
Dann wirst Du geholfen,
schöne Grüße,
Michael
P.S.: Paß bitte auf die Formulierung auf:


If Sheets("Auslieferung").Range("G3") >= 1 Then
   End If
Hier passiert schlicht nichts, weil zwischen Then und End If nichts steht.

Bild

Betrifft: AW: Makro zum vergleichen und verschieben von Werten
von: René Schönberg
Geschrieben am: 18.04.2015 12:56:46
Moin Michael,
ich kann keine Hilfsspalte bzw. Sortiertabelle verwenden, da diese Arbeitsmappe im Tagesgeschäft von 4-8 Mitarbeiten verwendet wird. Sie dient dazu einen Arbeitsprozess mit wenig Aufwand fortlaufend dynamisch zu steuern. In dieser Mappe dürfen und können alle Mitarbeiter auch nur über Makros eingaben machen. Ich habe die Datei in abgespeckter Form wie gewünscht hochgeladen.
https://www.herber.de/bbs/user/97150.xlsx

Bild

Betrifft: Datei
von: Michael
Geschrieben am: 18.04.2015 18:00:48
Hallo René,
die Mappe habe ich mir runtergeladen, das Makro reinkopiert und geschaut, was es so treibt.
Es ist mir völlig schleierhaft, was der Sinn ist: Du schaust *alle* Werte in der Spalte an, kopierst eine ganze Reihe davon "über- oder aufeinander", und es erscheint mir relativ zufällig, welcher Wert am Ende der ist, der nicht mehr überschrieben wird und in "Auslieferung" stehen bleibt.
Was ist das Besondere an dem Wert, der jeweils zuletzt geschrieben wird? Daß er der unterste in der Prüfliste ist?
Wenn das so ist, reicht es, die Tabelle von unten nach oben zu durchsuchen und die For Each abzubrechen, sobald der unterste Wert ermittelt ist.
Insgesamt läuft das Ding relativ langsam, was sich durch Verwendung von Variablen und evtl. einem anderen Schleifentyp (while) deutlich strukturierter programmieren und beschleunigen läßt.
No big deal, aber bevor ich mich da dran machen würde, möchte ich gern wissen, was der Sinn ist - ich arbeite nicht gern umsonst, und vergeblich schon gleich gar nicht.
Außerdem vermisse ich ein statement von Dir zu den zwei "sinnlosen" Zeilen, die *nichts* tun. Sollte das end if vielleicht woanders stehen?
Schöne Grüße,
Michael

Bild

Betrifft: AW: Datei
von: René Schönberg
Geschrieben am: 19.04.2015 14:23:55
Moin Michael,
ja das End If muss weiter nach unten. So, da hast du recht, macht es keinen Sinn.
Ich glaub ich habe mich falsch ausgedrückt. Ich brauche ein Makro das die Funktion von dieser Formel übernimmt:
{=WENNFEHLER(INDEX(Prüfliste!$B:$B;MIN(WENN(ISTNV(VERGLEICH(Prüfliste!$B$3:$B$3991; Ausgeliefert!$A$1:$A$4000;))*ISTNV(VERGLEICH(Prüfliste!$B$3:$B$3991;Auslieferung!$B$6:$B$43;)) *ISTNV(VERGLEICH(Prüfliste!$B$3:$B$3991;$B$5:$B5;))*(Prüfliste!$C$3:$C$3991="i.o") *(Prüfliste!$A$3:$A$3991="S2");ZEILE(Prüfliste!$3:$3991))));"") }
Da diese Formel in den Zellen vom Arbeitsblatt" "Puffer" von Zelle B6:E35 und leicht abgewandelt in dem Arbeitsblatt "Auslieferung" von Zelle B6:E35 drin steht macht sie die Mappe sehr langsam, da bei jedem eintrag in die Prüfliste alle Formel durchlaufen.
Die Arbeitsweise der Mappe ist folgende:
1. Stk-Nr. mit Segment und verwendbarkeit in die Prüfliste eintragen (Makro vorhanden)
2. Auslieferung erstellen (Makro vorhanden) eingetragen wird Auslieferdatum und Menge
3. Jetzt suchen die Formeln in dem Tabellenblatt "Auslieferung" die Stk-Nr. raus die die Suchkriterien erfüllen (Bsp.: 198566,"S2","i.o" und noch nicht in dem Arbeitsblatt "Ausgeliefert" verwendet)
-wenn alle Formeln entsprechend der Menge durchlaufen wurden habe ich im Arbeitsblatt "Auslieferung" eine mit Stk-Nr. gefüllte Tabelle
-in dem Arbeitsblatt "Puffer" tauchen diese Stk-Nr. nicht mehr auf da sie ja schon verwendet werden
4. Wenn die Auslieferung erfolgt ist wird mit einem Makro der Zellbereich in dem Arbeitsblatt "Auslieferung" der mit Stk-Nr. gefüllt ist in das Arbeitsblatt "Ausgeliefert" ans Ende kopiert und der gefüllte Zellbereich in dem Arbeitsblatt "Auslieferung" wieder leergemacht
5. Die nächste Auslieferung kann erstellt werden
Das ist der grobe Ablauf der Mappe.
Mir geht es nicht darum, dass du die Arbeit machst und mir ein fertiges Makro präsentierst.
Mir geht es eher darum ob das gezeigte Makro vom Lösungsansatz her richtig ist und/oder was muss ich anders machen um dahin zukommen wo ich hin will.
Da ich noch im Lernprozess bin fände ich es besser Lösungsansätze zu bekommen als die Lösung. :)
Entschuldige wenn ich mich hin und wieder mal knapp bzw. nicht korrekt ausdrücke, aber wenn 2 kleine Kinder um einen rumwurschteln ist es etwas schwierig sich zu konzentrieren.
Ich hoffe, ich konnte jetzt die noch offenen Fragen beantworten.
Gruß
René

Bild

Betrifft: Datei; Zwischenstand
von: Michael
Geschrieben am: 19.04.2015 16:01:07
Hallo René,
ich muß zugeben, daß ich mit VBA eher vertraut bin als mit ellenlangen Excel-Formeln; deshalb habe ich Dich auch darum gebeten, mir in Worten zu erklären, was das Makro tun soll - bis ich begriffen habe, was die zitierte Formel treibt, habe ich das Makro zweimal angepaßt.
Bevor ich in den Betreff "wer anderes bitte" schreibe, noch ein Anlauf:
- wohin gehört denn nun das end if?
- wenn ich Dich richtig verstehe ("habe ich im Arbeitsblatt "Auslieferung" eine mit Stk-Nr. gefüllte Tabelle"), sollen *mehrere* Zeilen herauskommen und nicht wie im Makro formuliert immer wieder in die Zeile 6 ("Destination:=Sheets("Auslieferung").Cells(6, 2)") geschrieben werden - das erscheint mir doch mal deutlich logischer!
Das noch vorab: Der Vergleich "Sheets("Ausgeliefert").Cells(Rows.Count, 1)" führt zu nichts, wovon Du Dich überzeugen kannst, wenn Du die beiden Codezeilen ausführst:

MsgBox Sheets("Ausgeliefert").Rows.Count
MsgBox "-" & Sheets("Ausgeliefert").Cells(Rows.Count, 1) & "-"
Also gut, ich setz mich mal dran.
Bis nachher,
Michael

Bild

Betrifft: Lösung
von: Michael
Geschrieben am: 19.04.2015 18:48:27
Hallo René,
derweil die Tücke oft im Detail steckt, tu ich mir leichter, eine Lösung auszuarbeiten (dann seh ich nämlich, wo sie hakelt, wenn ich sie teste) als einen reinen Ansatz zu formulieren.
Probier das nachfolgende Makro mal aus. Wenn ich Dich richtig verstanden habe und die Ausgabe Deinen Vorstellungen entspricht, erkläre ich Dir im Nachhinein gerne noch, warum ich was wie gemacht habe.
Einige Eckpunkte vielleicht vorab:
1. Wenn Vergleiche usw. einzelne Werte/Zellen mehrfach betreffen, ist es sinnvoller, sie einmal in eine Variable zu stecken anstatt erneut auf die Zelle zuzugreifen.
2. Es genügt, den Datenbestand einmal zu durchlaufen.
3. Die Abfrage auf "i.o" erfolgt als erstes, weil wenn nein die Schleife schon durch ist.
4. Aus der Ziffer in Sx wird die Spaltennummer errechnet (Ziffer als Buchstabe *1=Zahl); mit der wird dann entsprechend weitergearbeitet, mit *einem* Code für alle Spalten bzw. Segmente.
5. Anstatt die Zelle mit dem Wert zu kopieren, wird schlicht der Wert in die Zielzelle geschrieben.
Alles läuft relativ langsam (20-30s), was womöglich daran liegt, daß die Zahlen als DOUBLE dimensioniert sind (also Dezimalzahlen)(kannst Dir ansehen mit msgbox typename range(bla)), von denen aber nur der ganzzahlige Anteil verwendet wird. Eine Formatierung als "portugiesische Postleitzahl" ist mir noch nicht untergekommen!
Mit Ganzzahl (long) und (evtl.) Formatierung auf 6 Stellen bist Du grad so weit, und es sollte schneller gehen.

Option Explicit
Dim arr As Variant
Function nicht_vorhanden(ByVal w As Double, ByVal s As Long, ByVal bis As Long)
 Dim i As Long, nv As Boolean
 nv = True
 i = 1
 While i < bis And nv
  If arr(i, s) = w Then nv = False
  i = i + 1
 Wend
 nicht_vorhanden = nv
End Function
Sub Kopieren()
Dim rng As Range
Dim seg As String, Sp As String
Dim z_max As Long, z_PL As Long, Spalte As Long, aus_max As Long, i As Long
Dim z(4) As Long, z_aus(4) As Long
Dim wert As Double
' Application.ScreenUpdating = False
z_max = Sheets("Prüfliste").Range("B" & Rows.Count).End(xlUp).Row
aus_max = 0
For Spalte = 1 To 4
 z_aus(Spalte) = Sheets("Ausgeliefert").Cells(Rows.Count, Spalte).End(xlUp).Row
 If z_aus(Spalte) > aus_max Then aus_max = z_aus(Spalte)
Next
arr = Sheets("Ausgeliefert").Range("A2:D" & aus_max)
aus_max = 0
For Spalte = 0 To 4
 z(Spalte) = 6
Next
For z_PL = 3 To z_max
  seg = Sheets("Prüfliste").Cells(z_PL, 1)
  wert = Sheets("Prüfliste").Cells(z_PL, 2)
  Sp = Sheets("Prüfliste").Cells(z_PL, 3)
  If Sp = "i.o" Then
    Spalte = Mid(seg, 2, 1) * 1 - 1
    If nicht_vorhanden(wert, Spalte, z_aus(Spalte)) Then
'      Sheets("Prüfliste").Cells(z_PL, 2).Copy _
'      Destination:=Sheets("Auslieferung").Cells(z(Spalte), Spalte + 1)
      Sheets("Auslieferung").Cells(z(Spalte), Spalte + 1).Value = wert
      z(Spalte) = z(Spalte) + 1
      If z(Spalte) > aus_max Then aus_max = z(Spalte)
    End If
  End If
Next
For i = 1 To aus_max - 6
   Sheets("Auslieferung").Range("A" & 5 + i) = "Satz " & i
Next
' Application.ScreenUpdating = True
End Sub

Na dann, bis auf weiteres schöne Grüße,
Michael

Bild

Betrifft: AW: Lösung
von: René Schönberg
Geschrieben am: 19.04.2015 23:35:50
Moin Michael,
also dein Makro läuft super.
Zu dem End If - das muss ans Ende der Prozedur, denn es sollen nur so viele Stk-Nr. ausgegeben werden wie die Satzabfrage ist. In dem "falschen Makro" stehen die abgefragten Sätze in der Zelle "G3". Das bedeutet wenn in "G3" eine "1" drin steht dann soll 1 Satz aufgelistet sein. Bei einer "6" sollen 6 Sätze usw. dies kann bis 20 Sätze gehen. Kann man das in deinem Makro noch anpassen?
Die Formatierung der Stk-Nr. als "portugisische Postleitzahl" ist ein fehler. In der Originalversion sind sie als Zahl formatiert.
Es tut mit leid das ich mich eventuell falsch ausgedrückt bzw. die Arbeitsweise der Mappe nicht eindeutig erklärt habe, aber wenn man jeden Tag damit arbeitet und sie zudem noch selbst erstellt hat ist einem klar wie der Ablauf ist.
Ich würde gern auf dein Angebot, mir die Arbeitsweise deines Makros zu erklären, eingehen.
Vielen Dank für deine Ausdauer und Geduld.
Gruß
René

Bild

Betrifft: Mal sehen
von: Michael
Geschrieben am: 20.04.2015 17:50:54
Hallo René,
klar kann man das Makro anpassen, damit nur n Zeilen ausgegeben werden. Aber das ist halt die Sache, die mir von vornherein "portugiesisch" vorkam, daß das Ergebnis mehr oder weniger zufällig ist (naja, nicht ganz, die obersten zuerst). Ich vermisse irgendwie, daß die Daten in der Prüfliste gelöscht werden, sobald sie übernommen wurden.
Du schreibst bei Version: egal, aber vielleicht ist es doch nicht ganz egal, wenn so was wie portug. dabei rauskommt.
Trotzdem egal. Ich komme heute nicht mehr dazu; mehr hoffentlich morgen.
Bis dahin schöne Grüße,
Michael

Bild

Betrifft: Lösung
von: Michael
Geschrieben am: 21.04.2015 17:21:28
Hallo René,
anbei die Datei incl. Makro: https://www.herber.de/bbs/user/97213.xlsm
Ich weiß jetzt auch nicht, was ich machen soll: ich hab Dir ne Erklärung angeboten, aber wenn ich bei Adam und Eva anfange, sitze ich morgen noch da. Spiel halt mal ein bißchen damit herum, und wenn Dir was Konkretes schleierhaft ist, fragst halt nochmal.
Das Abschalten der automatischen Kalkulation hat das Ding deutlich beschleunigt; es läuft jetzt richtig fix.
Außerdem habe ich noch die Variablen "raus" eingeführt, die die Schleife vorzeitig abbrechen, wenn die gewünschte Anzahl an Werten vorhanden ist.
Für weitere Optimierungen gibt es deutlichen Spielraum, aber wenn es so rennt, soll's ja gut sein.
Schöne Grüße,
Michael

Bild

Betrifft: AW: Lösung
von: René Schönberg
Geschrieben am: 21.04.2015 20:03:41
Moin Michael,
das Makro ist echt genial. Das minimiert unsere Wartezeit bei der Eingabe in die Liste auf null. Perfekt.
Die Excelversion muss egal sein da bei uns noch mit 3 verschiedenen Excel´s gearbeitet wird, von 2007-2013.
Die Werte in der Prüfliste müssen für die wöchentliche, monatliche und jährliche Auswertung drin bleiben.
Dahinter steht noch eine Mappe die die Prüfliste bzw. den Schrottanteil in einem gewissen Zeitraum auswertet.
So war das auch nicht gemeint, ein paar Komentare in der Programierung hätten ja gereicht ;)
z_max = Sheets("Prüfliste").Range("B" & Rows.Count).End(xlUp).Row
aus_max = 0
For Spalte = 1 To 4
raus(Spalte) = False
z_aus(Spalte) = Sheets("Ausgeliefert").Cells(Rows.Count, Spalte).End(xlUp).Row
If z_aus(Spalte) > aus_max Then aus_max = z_aus(Spalte)
In diesem Segment bekomm ich die "Wenn abfrage" nicht so ganz auf die Reihe.
"Wenn z_aus(1-4) > 0 Dann 0 = z_aus(1-4)" Was macht es hier?
Und was bedeutet diese Zeile?
Spalte = Mid(seg, 2, 1) * 1 - 1
Der Rest ist soweit verständlich.
Nochmals vielen, vielen Dank!!
Gruß
Rene

Bild

Betrifft: fein, fein
von: Michael
Geschrieben am: 21.04.2015 23:15:52
Hallo René,

z_max = Sheets("Prüfliste").Range("B" & Rows.Count).End(xlUp).Row

ermittelt die unterste, mit Werten gefüllte Zeile in der Prüfliste - das war Dir ja klar, denke ich.
In der folgenden Schleife geht es um das Blatt "Ausgeliefert", das in der Beispieltabelle Spalten unterschiedlicher Länge besitzt (naja, alle sind "gleichlang", aber die linke enthält 3 Werte, die weiteren nur jeweils einen: sofern hier regelmäßig leere Zellen vorhanden sind, könnte man die noch raussortieren).
In z_aus (für "Zeile Ausgeliefert") werden die max. .row-Werte der vier Spalten gespeichert. Ich lade den ganzen Bereich in ein "array" (weil das schneller ist als der Zugriff auf Zellen einer Tabelle), und weil das Array "rechteckig" ist, wird mittels aus_max ermittelt, welche die Spalte mit den meisten Werten ist.
Du kannst Dir einen Haltepunkt vor die For-Schleife setzen und das Makro zeilenweise mit F8 laufen lassen; wenn Du den Mauszeiger über einen Variablennamen hältst, siehst Du den jeweiligen Wert.
aus_max hat zunächst den Wert 0 und wird mit der "Höhe" der jeweiligen Spalte verglichen: ist die Spalte "höher" (ist .row größer), wird die 0 durch den .row ersetzt. Usw. Am Ende weißt Du, welches die längste Spalte ist.
Kann sein, ich hab mir die Arbeit umsonst gemacht, wenn die Spalten immer gleichmäßig mit Werten gefüllt sind, aber auch schon egal.
Ja, genau, mir ging es beim Überprüfen der "ausgelieferten" Spalten darum, möglichst wenig Werte vergleichen zu müssen.
Die Zeile

Spalte = Mid(seg, 2, 1) * 1 - 1

holt sich aus dem String seg ab der zweiten (2) Position im String *einen* (1) Wert; es steht z.B. "S2" drin, dann ermittelt Mid(seg, 2, 1) eine "2" (als Teilstring bzw. Buchstabe) und durch die Multiplikation mit 1 wird die *Zahl* 2 draus. Du hast ja Werte von S2 bis S5 und Spalten von 1 bis 4, deshalb ziehe ich noch eine 1 ab.
Alles klar?
Das noch: Die Werte in der Prüfliste müssen für die wöchentliche, monatliche und jährliche Auswertung drin bleiben. Man könnte dem Makro einige Arbeit sparen, wenn man eine weitere Spalte hinzufügt, in der das Makro etwa ein "x" setzt, wenn es den Wert exportiert - oder meinetwegen auch ein Datum; das hätte man dann gleich für spätere Auswertungen zur Verfügung.
Danke für das freundliche Feedback & schöne Grüße,
Michael

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Makro zum vergleichen und verschieben von Werten"