Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
1452to1456
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro ist falsch, schleife läuft nicht richtig.

Makro ist falsch, schleife läuft nicht richtig.
24.10.2015 09:30:00
Lukas
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

    9
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Makro ist falsch, schleife läuft nicht richtig.
    24.10.2015 10:06:45
    Lukas
    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

    Teste mal...
    24.10.2015 19:00:07
    Michael
    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

    Anzeige
    AW: Teste mal...
    25.10.2015 11:21:06
    Lukas
    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
    

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

    Bitte *nicht* auf den Rechner "hacken"
    25.10.2015 15:09:09
    Michael
    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 

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

    Anzeige
    AW: Bitte *nicht* auf den Rechner "hacken"
    25.10.2015 17:19:54
    Lukas
    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

    Anzeige
    Erweiterung
    26.10.2015 18:14:52
    Michael
    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

    Anzeige
    AW: Erweiterung
    27.10.2015 19:09:15
    Lukas
    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

    Anzeige
    gerne, anbei noch eine kleine Studie
    28.10.2015 16:06:25
    Michael
    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
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige