Do Schleife

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

Betrifft: Do Schleife
von: Manuel
Geschrieben am: 09.11.2015 20:40:40

Hallo liebe Forumsmitglieder,
ich bin gerade dabei mittels Makro ein Arbeitssheet aufzubereiten welches ich vorher importiere aus einer anderen Liste.
Die Ursprungsdatei ist so aufgebaut, dass in Spalte A immer zuerst der Auftrag und darunter dann die Mitarbeiter stehen die den Auftrag abgewickelt haben. Zwischen dem letzten Mitarbeiter eines auftrages und des Namens des neuen Auftrages ist immer eine Leerzeile. Ich muss für eine spätere Bewertung die Namen des Auftrages in Spalte E schreiben, für jeden Mitarbeiter der unter dem Auftrag läuft.
Hier mal ein Beispiel:

Auftrag 1
Mitarbeiter 1
Mitarbeiter 2
Mitarbeiter 3
Auftrag 2
Mitarbeiter 1
Mitarbeiter 2
...
Ich habe das ganze versucht mit mehrere Schleifen zu lösen, jedoch klappt es nicht so wie ich es gerne hätte. Bei der Do Schleife hängt sich Excel immer auf. Habt ihr eine Lösung für mich?

Sub Zeiten_dieZweite()
Dim lnglast As Long
lnglast = Sheets("Upload_Zeiten").Range("A65536").End(xlUp).Row
u = lnglast + 1
For z = 3 To u
If Sheets("Upload_Zeiten").Cells(z, 2).Value = "" Then
p = z - 1 'hier 47
Exit For
End If
Next z
For k = 3 To p
Sheets("Upload_Zeiten").Cells(k, 5).Value = Sheets("Upload_Zeiten").Cells(2, 1).Value
Next k
'Do Until p >= lnglast
p = p + 3
For i = p To lnglast
If Sheets("Upload_Zeiten").Cells(i, 2).Value = "" Then
l = i - 1
Exit For
End If
Next i
For m = p To l
    For g = 1 To p
    Sheets("Upload_Zeiten").Cells(m, 5).Value = Sheets("Upload_Zeiten").Cells(m - g, 1).Value
    Next g
Next m
p = l
'Loop
MsgBox p
End Sub

Danke
Manuel

Bild

Betrifft: AW: Do Schleife
von: fcs
Geschrieben am: 10.11.2015 00:58:49
Hallo manuel,
deine Beschreibung ist leider etwas unverständlich.
Lade hier eine Beispiel-Datei hoch mit 2 Tabellenblättern
vorher (vor der Ausführungt des Makros)
nacher (nach der Ausführung des Makros)
Personenbezogene Daten kannst du ja ggf. anonymisieren.
Ergänze ggf. eine Beschreibung, nach welchen Kriterien die Daten umgestellt werden sollen.
Gruß
Franz

Bild

Betrifft: AW: Do Schleife
von: Over
Geschrieben am: 10.11.2015 10:12:36
Hallo Manuel,
ich gehe mal davon aus, dass je Auftrag in deiner Liste 0 ... n MA zugeordnet sein können.
Das Beispiel sieht erstmal nur 10 Datensätz vor - eingelesen in eine Variable.
Alle MA-Namen werden in ein Feld aneinander gereiht, durch Leerzeichen getrennt.


Sub MA_AA()
Dim AA_MA_Dat(1 To 10, 1 To 2) As Variant
spalte = 1 'Spalte wo die Daten stehen
zeile = 2  'erste Zeile mit AA-Nr
AA_z = 0: MA_z = 0
Do
  If Cells(zeile, spalte) = "" Then MA_z = 0: GoTo Folgedatensatz  'nächste AA-Nr
  If MA_z = 0 Then
     AA_z = AA_z + 1  ' neue Auftragsnummer
     AA_MA_Dat(AA_z, 1) = Cells(zeile, spalte)
     MA_z = 1         ' danach nur MA erfassen
  Else
     AA_MA_Dat(AA_z, 2) = AA_MA_Dat(AA_z, 2) + " " + Cells(zeile, spalte)
  End If
Folgedatensatz:
  zeile = zeile + 1
 
Loop Until Cells(zeile + 1, spalte) & Cells(zeile, spalte) = "" 'wenn zwei Leerzeilen = Ende  _
erreicht
End Sub
war es das, was du gesucht hast?
Lg
Daniel Ov

Bild

Betrifft: AW: Do Schleife
von: Manuel
Geschrieben am: 10.11.2015 13:59:04
Danke für eure Antworten! Daniel deine Lösung funktioniert leider nicht.
Entschuldigt das ich das ganze vielleicht etwas unschlüssig erklärt habe, hier aber mal meine Beispieltabelle. Dabei ist einmal die Tabelle wie sie vor Makro ausführung aussieht und einmal ohne. Meinen Code hab ich in Modul1 hinterlegt.
https://www.herber.de/bbs/user/101388.xlsm
Danke und vielen Grüße

Bild

Betrifft: AW: Do Schleife
von: Over
Geschrieben am: 10.11.2015 16:34:14
Hallo Manuel,
mit Beispiel wird es anschaulich - und einfacher in der Umsetzung :)


Sub MA_AA_V2()
Sheets("zu bereinigen").Select
spalte = 1 'Spalte wo die Daten stehen
spalte_AA_Nr = 5 'Spalte wo AA-Nr. rein soll
zeile = 2  'erste Zeile mit AA-Nr
Do
   AA_Nr = Cells(zeile, spalte) ' AA-Nr einlesen
   Cells(zeile, spalte).EntireRow.Delete 'Zeile mit AA-Nr. löschen
   
  Do
    Cells(zeile, spalte_AA_Nr) = AA_Nr  'Auftragsnummern in MA-Zeile eintragen
    zeile = zeile + 1
  Loop Until Cells(zeile, spalte) = ""
 Cells(zeile, spalte).EntireRow.Delete 'Leer-Zeile zum nächsten AA löschen
Loop Until Cells(zeile, spalte) = "" 'wenn immer noch Leerzeilen = Ende erreicht
Cells(zeile, spalte).EntireRow.Delete 'letzte Summe-Zeile löschen
End Sub
passt es besser?
Lg
Daniel Ov

Bild

Betrifft: AW: Daten umgruppieren
von: fcs
Geschrieben am: 11.11.2015 11:56:15
Hallo Manuel
hier mein Lösungsvorschlag
Gruß
Franz

Sub Zeiten__2()
  'Überträgt den Code in Spalte A nach Spalte 5 (E) und löscht nicht benötigte Zeilen.
  Dim wks As Worksheet
  Dim SpaNo As Long, Zeile As Long, Zeile_L As Long
  Dim arrTemp, arrZiel, varNo
  
  Set wks = ActiveSheet 'oder  = Worksheets("Vor_Makro")
  SpaCode = 1 'Spalte A - Spalte in der die Nummern oberhalb der Namen stehen
  SpaNo = 5 'Spalte E - Spalte in die die Nummer in Spalte A übertragen werden soll
  
  'Makrobremsen lösen
  With Application
    .ScreenUpdating = False
    StatusCalc = .Calculation
    .Calculation = xlCalculationManual
  End With
  
  With wks
     With .UsedRange
        Zeile_L = .Row + .Rows.Count - 1 'Letzte verwendete
     End With
     varNo = ""
     'Werte in Spalte A in Datenarray einlesen
     arrTemp = .Range(.Cells(1, SpaCode), .Cells(Zeile_L, SpaCode))
     'Werte in Spalte E in Datenarray einlesen
     arrZiel = .Range(.Cells(1, SpaNo), .Cells(Zeile_L, SpaNo))
     For Zeile = 2 To Zeile_L                               '2 = Zeile mit 1. Nummer
        If varNo = "" And arrTemp(Zeile, 1) <> "" Then
           varNo = arrTemp(Zeile, 1)
           arrZiel(Zeile, 1) = True
        ElseIf varNo <> "" And arrTemp(Zeile, 1) = "" Then
           arrZiel(Zeile, 1) = True
           varNo = ""
        ElseIf varNo <> "" And arrTemp(Zeile, 1) <> "" Then
           arrZiel(Zeile, 1) = varNo
        Else
           arrZiel(Zeile, 1) = True
        End If
     Next
     Erase arrTemp
     .Range(.Cells(1, SpaNo), .Cells(Zeile_L, SpaNo)) = arrZiel
     'Zeilen löschen, die in Spalte E Wert "WAHR" haben
     With .Range(.Cells(2, SpaNo), .Cells(Zeile_L, SpaNo))
        .SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete shift:=xlShiftUp
     End With
  End With
  'Makrobremsen zurücksetzen
  With Application
    .ScreenUpdating = True
    .Calculation = StatusCalc
  End With
End Sub


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Do Schleife"