Makro ist falsch, schleife läuft nicht richtig.

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

Betrifft: Makro ist falsch, schleife läuft nicht richtig.
von: Lukas
Geschrieben am: 24.10.2015 09:30:00

Hallo an alle
Ich hab ein kleines Problem, ich hab ein Makro das daTensetze aus tab1 in tab2 dem Datum nach einordnet. In Tab2 sind Kalenderwochen waagrecht angeordnet Alle 12 spalten fängt eine neue KW an.
Jetzt ist das Problem das es zwar richtig zuordnet aber wenn das Datum des Datensatzes in Tab 1 eine Woche überschreitet dann wird er nur ich die ersten Woche kopiert.
Das ist das Makro

  • 
    Sub Kopieren(Zeile As Long)
      Dim wsDaten As Worksheet
      Dim wsZiel As Worksheet
      Dim lngSpalteD As Long
      Dim lngZeileD As Long
      Dim strSpalte As String
      Dim rng As Range
      Set wsDaten = Worksheets("UP Datum")
      Set wsZiel = Worksheets("UP Wochen")
    'Variable Erster Bereich Enddatum
      lngSpalteD = 7
      Do Until IsEmpty(wsZiel.Cells(2, lngSpalteD)) Or wsZiel.Cells(2, lngSpalteD) >= wsDaten.Cells( _
    Zeile, 6)
        lngSpalteD = lngSpalteD + 12
      Loop
    If Not IsEmpty(wsZiel.Cells(2, lngSpalteD)) Then
        strSpalte = Mid(Cells(2, lngSpalteD + 5).Address, 2, InStr(2, wsZiel.Cells(2, lngSpalteD +  _
    5).Address, "$") - 2)
        Set rng = wsZiel.Range(strSpalte & ":" & strSpalte).Find(What:=wsDaten.Cells(Zeile, 12).  _
    Value)
        If rng Is Nothing Then
          lngZeileD = 4
          Do Until IsEmpty(wsZiel.Cells(lngZeileD, lngSpalteD - 3))
            lngZeileD = lngZeileD + 1
          Loop
        Else
          lngZeileD = rng.Row
        End If
        wsDaten.Range(Cells(Zeile, 1).Address & ":" & Cells(Zeile, 12).Address).Copy wsZiel.Range(  _
    Cells(lngZeileD, lngSpalteD - 6).Address)
      End If
      
      wsZiel.UsedRange.FormatConditions.Delete
    End Sub

  • Wie pass ich das richtig an?
    Danke für die Hilfe
    Gruß Lukas

    Bild

    Betrifft: AW: Makro ist falsch, schleife läuft nicht richtig.
    von: Lukas
    Geschrieben am: 24.10.2015 10:06:45
    Das wäre noch eine test datei damit man es sich etwas besser vorstellen kann.
    https://www.herber.de/bbs/user/101007.xlsm
    Gruß Lukas

    Bild

    Betrifft: Teste mal...
    von: Michael
    Geschrieben am: 24.10.2015 19:00:07
    Hi Lukas,
    ich habe mal eine zweite Variable für die Spalten eingefügt und eine zweite, ganz rechts auf "7" geänderte Schleife, so daß Du insgesamt von..bis angezeigt bekommst:

    Option Explicit
    Sub Kopieren(Zeile As Long)
      Dim wsDaten As Worksheet
      Dim wsZiel As Worksheet
      Dim lngSpalteD As Long, lngSpalteD2 As Long
      Dim lngZeileD As Long
      Dim strSpalte As String
      Dim rng As Range
      Set wsDaten = Worksheets("UP Datum")
      Set wsZiel = Worksheets("UP Wochen")
    'Variable Erster Bereich Enddatum
      lngSpalteD = 7
      lngSpalteD2 = 7
    ' Schleife bis TabZiel enddatum leer ist ODER TabZiel enddatum größer/Gleich TabDaten  _
    StartDatum
      Do Until IsEmpty(wsZiel.Cells(2, lngSpalteD)) Or wsZiel.Cells(2, lngSpalteD) >= wsDaten.Cells( _
    Zeile, 6)
        lngSpalteD = lngSpalteD + 12
      Loop
      Do Until IsEmpty(wsZiel.Cells(2, lngSpalteD2)) Or wsZiel.Cells(2, lngSpalteD2) >= wsDaten. _
    Cells(Zeile, 7)
        lngSpalteD2 = lngSpalteD2 + 12
      Loop
      MsgBox lngSpalteD & " <-> " & lngSpalteD2
    ' ab hier vorhandener Code ...
    

    Im Prinzip müßtest Du nur die restlichen Funktionen in einer Schleife so oft wiederholen wie erforderlich, sinngemäß:
    
    For lngSpaltenZähler = lngSpalteD to lngSpalteD2 step 12
      ' machen
    Next
    
    Im Prinzip gehört sich das Makro aber optimiert, wozu ich jetzt keine Zeit habe.
    Außerdem finde ich persönlich so endlos lange Quertabellen unschön: hast Du auf Deiner Maus ein seitliches Scrollrad? Nein.
    Als kleinen Gedankenanstoß würde ich vorschlagen, daß Du nur *eine* Tabelle führst, "UP Datum" nämlich, und bei dieser rechts Hilfsspalten mit den Nummern der KWen anbringst - für Ausdrucke kannst Du dann easy nach KW sortieren, filtern usw.
    Schöne Grüße,
    Michael

    Bild

    Betrifft: AW: Teste mal...
    von: Lukas
    Geschrieben am: 25.10.2015 11:21:06
    Hallo Michael
    Was den aufbau der Tabelle angeht hast du vollkommen recht das Problem ist das es leider so aufgebaut bleiben muss. Danke für deine hilfe Ich hab deine änderungen eingefügt und den rest des codes in die schleife gepackt. Ich habs Probiert, es klappt aber leider nicht der Datensatz landet leider immernoch nur in der ersten kalenderwoche des zeitraums aber nicht in den restlichen. Hast du das so gemein,oder hab ich was falsch verstanden ?

  • Sub Kopieren(Zeile As Long)
      Dim wsDaten As Worksheet
      Dim wsZiel As Worksheet
      Dim lngSpalteD As Long, lngSpalteD2 As Long
      Dim lngZeileD As Long
      Dim strSpalte As String
      Dim rng As Range
    Dim lngSpaltenZähler As Long
      Set wsDaten = Worksheets("UP Datum")
      Set wsZiel = Worksheets("UP Wochen")
      lngSpalteD = 7
      lngSpalteD2 = 7
      Do Until IsEmpty(wsZiel.Cells(2, lngSpalteD)) Or wsZiel.Cells(2, lngSpalteD) >= wsDaten.Cells( _
    Zeile, 6)
        lngSpalteD = lngSpalteD + 12
      Loop
      Do Until IsEmpty(wsZiel.Cells(2, lngSpalteD2)) Or wsZiel.Cells(2, lngSpalteD2) >= wsDaten. _
    Cells(Zeile, 7)
        lngSpalteD2 = lngSpalteD2 + 12
      Loop
      MsgBox lngSpalteD & " <-> " & lngSpalteD2
    For lngSpaltenZähler = lngSpalteD To lngSpalteD2 Step 12
            
                  If Not IsEmpty(wsZiel.Cells(2, lngSpalteD)) Then
                    strSpalte = Mid(Cells(2, lngSpalteD + 5).Address, 2, InStr(2, wsZiel.Cells(2,  _
    lngSpalteD + 5).Address, "$") - 2)
                    Set rng = wsZiel.Range(strSpalte & ":" & strSpalte).Find(What:=wsDaten.Cells( _
    Zeile, 12).Value)
            
                     If rng Is Nothing Then
                      lngZeileD = 4
                      Do Until IsEmpty(wsZiel.Cells(lngZeileD, lngSpalteD - 3))
                        lngZeileD = lngZeileD + 1
                      Loop
            
                
                    Else
                      lngZeileD = rng.Row
                    End If
            
                   wsDaten.Range(Cells(Zeile, 1).Address & ":" & Cells(Zeile, 12).Address).Copy  _
    wsZiel.Range(Cells(lngZeileD, lngSpalteD - 6).Address)
                  End If
    Next
    End Sub


  • Bild

    Betrifft: AW: Makro ist falsch, schleife läuft nicht richtig.
    von: Lukas
    Geschrieben am: 25.10.2015 11:26:14
    Hab vergessen das kontrollkästchen beim letzten post anzuhacken

    Bild

    Betrifft: Bitte *nicht* auf den Rechner "hacken"
    von: Michael
    Geschrieben am: 25.10.2015 15:09:09
    Hi Lukas,
    ich wollte Dir eigentlich nur die Funktionsweise bewußt machen und keinen fertigen Code liefern.
    Aber wenn Du das schon so weit umgesetzt hast... Der Punkt ist, daß die neue Zähler-Variable der Reihe nach alle Werte von D bis D2 annimmt, d.h. innerhalb der For-Schleife mußt Du dann "natürlich" alle D durch den Zähler ersetzen; ich habe es in Deinen ursprünglichen Code eingebaut, mitsamt einer zweiten MsgBox, die den jeweils aktuellen Wert des Zählers anzeigt:

    Sub Kopieren(Zeile As Long)
      Dim wsDaten As Worksheet
      Dim wsZiel As Worksheet
      Dim lngSpalteD As Long, lngSpalteD2 As Long
      Dim lngSpaltenZähler As Long
      Dim lngZeileD As Long
      Dim strSpalte As String
      Dim rng As Range
      Set wsDaten = Worksheets("UP Datum")
      Set wsZiel = Worksheets("UP Wochen")
    'Variable Erster Bereich Enddatum
      lngSpalteD = 7
      lngSpalteD2 = 7
    ' Schleife bis TabZiel enddatum leer ist ODER TabZiel enddatum größer/Gleich TabDaten  _
    StartDatum
      Do Until IsEmpty(wsZiel.Cells(2, lngSpalteD)) Or wsZiel.Cells(2, lngSpalteD) >= wsDaten.Cells( _
    Zeile, 6)
        lngSpalteD = lngSpalteD + 12
      Loop
      Do Until IsEmpty(wsZiel.Cells(2, lngSpalteD2)) Or wsZiel.Cells(2, lngSpalteD2) >= wsDaten. _
    Cells(Zeile, 7)
        lngSpalteD2 = lngSpalteD2 + 12
      Loop
      MsgBox lngSpalteD & " <-> " & lngSpalteD2
      
      For lngSpaltenZähler = lngSpalteD To lngSpalteD2 Step 12
    'Wenn TabZiel enddatum des Identifizierten Bereichs nicht leer, dann Überprüfen ob Datensatz  _
    bereits in Identivizierten Bereich bereits vorhanden
    'derzeit anhand einer Wertüberinstimmung zwischen der 12 Spalte TabDaten und 12 Spalte des  _
    identifizierten Bereichs
    '***Änderungsbedarf: es sollten mindestens 3 Zellen pro datensatz abgeglichen werden.
      MsgBox "lngSpaltenZähler hat jetzt den Wert " & lngSpaltenZähler
      If Not IsEmpty(wsZiel.Cells(2, lngSpaltenZähler)) Then
        strSpalte = Mid(Cells(2, lngSpaltenZähler + 5).Address, 2, InStr(2, wsZiel.Cells(2,  _
    lngSpaltenZähler + 5).Address, "$") - 2)
        Set rng = wsZiel.Range(strSpalte & ":" & strSpalte).Find(What:=wsDaten.Cells(Zeile, 12). _
    Value)
    'Wenn Wertübereinstimmung nicht gefunden dann
        If rng Is Nothing Then
          lngZeileD = 4
          Do Until IsEmpty(wsZiel.Cells(lngZeileD, lngSpaltenZähler - 3))
            lngZeileD = lngZeileD + 1
          Loop
    'Wenn Wertübereinstimmung gefunden dann Zeile des Treffers bestimmen
        Else
           lngZeileD = rng.Row
    '    If lngZeileD < 3 Then lngZeileD = lngZeileD + 1
    '    End If
        
        End If
    ' Kopieren des Datensatzes in den identiffizirten Zielbereich aber leider nur in den ersten der  _
    vom datum zutrifft
    '**Wenn Datensatz in Bereich bereits vorhanden dann wird er überschreiben
    '**Wenn Datensatz in Bereich bereits vorhanden dann wird er in die nächste frei Zeile des  _
    bereichs Kopiert.
        wsDaten.Range(Cells(Zeile, 1).Address & ":" & Cells(Zeile, 12).Address).Copy wsZiel.Range( _
    Cells(lngZeileD, lngSpaltenZähler - 6).Address)
      End If
      
      'Bedingte formatierungen aus TabZiel löschen
      '** Änderungsbedarf Da sollt die Formatierung als normale Formatierung Kopiert werdenIm  _
    momment lösch ich sie einfach
      wsZiel.UsedRange.FormatConditions.Delete
      Next
    End Sub
    

    Die zwei MsgBoxen kannst Du natürlich am Ende Deiner Testphase rauswerfen.
    Schöne Grüße,
    Michael

    Bild

    Betrifft: AW: Bitte *nicht* auf den Rechner "hacken"
    von: Lukas
    Geschrieben am: 25.10.2015 17:19:54
    Hi Michael
    Funktioniert bestens :))))))) vielen vielen Dank.
    Ich hab da noch ein zweites Sache mit dem makro. Ich wollt eigentlich ein neues thema aufmachen aber vielleicht kannst du mir da ja weiterhelfen. Das Makro solle Einträge überschreiben wenn es diese in Tab 2 schon einmal vorkommen und wenn nicht dann in die erste verfügbare Zeile der jeweiligen Kalenderwoche.
    Ich finde den Eintrag im momment mit .find es sucht in der 12 spalte einer jeden Kalenderwoche. Bei find kenn ich nur ein Kriterium angeben, das scheint aber zu wenig zu sein da wenn in der 12 spalte zbs. nichts steht dann schreibt er es einfach in die erste Zeile wo in der 12 spalt nichts steht und das ist die Zeile wo die Wochen beschriftet sind.

    If Not IsEmpty(wsZiel.Cells(2, lngSpaltenZähler)) Then
        strSpalte = Mid(Cells(2, lngSpaltenZähler + 5).Address, 2, InStr(2, wsZiel.Cells(2,  _
    lngSpaltenZähler + 5).Address, "$") - 2)
        Set rng = wsZiel.Range(strSpalte & ":" & strSpalte).Find(What:=wsDaten.Cells(Zeile, 12). _
    Value)

    Wenn ich mehr spalten als Kriterium angeben könnte dann würde das nicht passieren aber ich weis nicht so recht wie ich das am besten verwirklichen soll. Bzw. gibts eine andere Methode wie .find nur mit mehr Kriterien? Mit find scheint es nicht möglich zu sein :(
    Du hattest in deinem ersten post geschrieben das das Makro Optimiert gehört was genau hast du da gemeint?
    Gruß
    Lukas

    Bild

    Betrifft: Erweiterung
    von: Michael
    Geschrieben am: 26.10.2015 18:14:52
    Hi Lukas,
    mit "Optimierungen" meinte ich das .find, aber insgesamt die "Ausdrucksweise": so ist beispielsweise die Angabe von .address bei Range(cells(....)) eigentlich nicht erforderlich; andererseits hast Du auf diese Weise eigentlich fehlerhaften Code (beim copy) sehr kreativ funktionsfähig gemacht: lustige Variante - es gibt in Excel halt oft viele Wege, um was zu formulieren.
    Ich habe heute kaum Zeit, mir die Geschichte nochmal anzusehen, eher morgen.
    Aber sag bitte: um wieviele Daten geht es in der Praxis? 20? 200? 2000?
    Wird die Quer-Tabelle auch für Eingaben genutzt, oder wäre es evtl. sinnvoll, sie zunächst zu leeren und alles in einem Rutsch komplett zu kopieren, nicht zeilenweise, so wie jetzt?
    Oder so herum: nett wäre es eigentlich, nur den jeweils neu eingegebenen Datensatz zu übernehmen, aber das wirklich sauber zu machen, ist einigermaßen aufwendig (obwohl, mit einer zusätzlichen Spalte, in der ein "x" steht, wenn die Zeile bereits vorhanden ist).
    Ach genau, jetzt hat sich mein "Datenbank_Modul" zugeschaltet: in Datenbanken benutzt man generell einen "eindeutigen Schlüssel", um Verweise zwischen Tabellen zu realisieren: dafür wäre etwa eine fortlaufende Nummer geeignet (also hochformatige Tabelle: eine weitere Spalte, die durchnummeriert ist), und genau damit erreichst Du, daß Du nicht endlos verschiedene Felder vergleichen mußt, sondern nur nach dem Schlüssel suchen kannst.
    Das erfordert naturgemäß eine weitere Spalte, aber ob Du 12 dazuzählst oder 13, ist auch egal.
    Sag nicht, daß das nicht geht: da mußt Du Dich durchsetzen, das ist technisch erforderlich.
    .
    Bis morgen,
    Michael

    Bild

    Betrifft: AW: Erweiterung
    von: Lukas
    Geschrieben am: 27.10.2015 19:09:15
    Hallo Michael
    Also wenn ich mir das so durchlese dann komm ich zu dem Schluss das ich von vorne anfangen sollte und das ganze noch mal durchdenke und das mit den einzelnen Zeilen ganz weglasse. Stattdessen versuch ich mich an deinem Lösungsansatz und werde Tab 1 einfach immer neu in Tab 2 übertragen und damit auch jede Änderung und eine seriennummer oder Personalnummer oder etwas in dieser Richtung kommt auch dazu .
    Über deinen letzten Satz musst ich schmunzeln da er zeigt das du die Reaktion auf solche spalten kennst ;)
    Vielen dank du hast mir sozusagen die Augen geöffnet. Das jetzige Makro war auch nicht ganz umsonst da ich es mit Änderungen sicher anderweitig benutzen kann.
    Vielen vielen Dank
    Grüße Lukas

    Bild

    Betrifft: gerne, anbei noch eine kleine Studie
    von: Michael
    Geschrieben am: 28.10.2015 16:06:25
    Hallo Lukas,
    es freut mich, wenn ich Dir einige Gedankenanstöße geben konnte.
    Der Datenbank-Ansatz ist eine Sache, die andere ist, gedanklich nur *einen* Datenbestand zu führen und den "an Ort und Stelle" so aufzubereiten, daß Du nur angezeigt bekommst, was gerade erwünscht ist. Den Ansatz habe ich mal mit einem "Autofilter" verwirklicht.
    Aus gefilterten Daten *kann* man, wenn es denn "unbedingt" sein muß, Kopien ziehen, und zwar nur mit den im Filter angezeigten Werten: die landen testhalber im Blatt "...Form" wie "Formular", das man etwa für Ausdrucke verwenden oder auch wochenweise auf den Namen "KW_Nr" kopieren könnte.
    Den Filter kannst Du evtl. auch so umbauen, daß Deine "Quer-Liste" damit bestückt wird, aber für meinen Geschmack ist das vielleicht gar nicht mehr nötig.
    Spiel halt mal mit der Datei herum: https://www.herber.de/bbs/user/101098.xlsm
    Viel Spaß und laß Dir das Schmunzeln nicht verderben,
    Michael

     Bild

    Beiträge aus den Excel-Beispielen zum Thema "Makro ist falsch, schleife läuft nicht richtig."