Zeilen vereinzeln

Hallo Ihr lieben Helfer,
ich komme mit meinen Kenntnissen aktuell nicht weiter und könnte Eure Hilfe gebrauchen. Der bisherige VBA Code den ich erstellt habe, funktioniert leider nur bedingt. Teilweise produziere ich damit auch Laufzeitfehler und habe daher einige Zeile auskommentiert. Vielleicht habt Ihr Ideen und könnt mir auf die Sprünge helfen.

Auf dem Reiter MasterHU stehen die Einträge, die bearbeitet werden sollen.
Auf dem Reiter Vereinzelt soll das Ergebnis des VBA Codes eingetragen werden
Auf dem Reiter Test_MasterHU seht Ihr das gewünschte Ergebnis, wie es aussehen sollte

Im Anhang habe ich eine Beispieldatei hochgeladen in der folgendes passieren soll: (Teile davon habe ich bereits realisieren können)
- Die Daten auf dem Reiter MasterHU sollen vereinzelt werden und im Reiter Vereinzelt dargestellt werden
- Für jede Zeile aus dem Reiter MasterHU soll zuerst eine Dummyzeile eingefügt werden, bevor die Sachnummer anhand der EinzelMengen aufgeteilt darunter stehen.
- Die Einträge der Spalten A bis L sollen zeilenweise mit eingetragen werden
- Die Einträge der Spalte C, D, F, G sollen je nach Zeile angepasst werden
- In der Dummyzeile muss die Spalte D und F geändert werden
- In den Zeilen für die Sachnummern müssen die Spalte C, F und G geändert werden
- Dabei sind die Werte aus dem Reiter MasterHU Spalte M und N zu verwenden

Ich hoffe, dass ich das einigermaßen erklärt habe und Ihr mir anhand der Beispieldatei helfen könnt.
Leider werde ich heute nicht mehr antworten können, aber morgen auf jeden Fall.

Vielen Dank schon einmal für Eure Hilfe!
Gruß Ulf

https://www.herber.de/bbs/user/167976.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub DatenVereinzeln() Dim wsMaster As Worksheet Dim wsVereinzelt As Worksheet Dim lastRow As Long Dim i As Long Dim dummyRow As Long Dim huNummer As Long Dim menge As Long, teiler As Long Dim vereinzelteZeilen As Long Dim arr Dim bhtyp, bhtypneu, sachnummer, arr1 ' Setze Arbeitsblätter Set wsMaster = ThisWorkbook.Sheets("MasterHU") Set wsVereinzelt = ThisWorkbook.Sheets("Vereinzelt") ' Lösche vorhandene Daten auf dem Blatt "Vereinzelt" wsVereinzelt.Cells.Clear ' Finde die letzte Zeile im MasterHU lastRow = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row ' Kopiere die Überschrift und Daten wsMaster.Range("A1:L1").Copy wsVereinzelt.Range("A1") ' Initialisiere Variablen dummyRow = 2 ' Startzeile für Dummy-Einträge huNummer = 1 ' Startwert für HU-Nummer ' Durchlaufe die Zeilen im MasterHU-Blatt For i = 2 To lastRow With wsMaster arr1 = .Cells(i, 1).Resize(, 12).Value huNummer = .Cells(i, "C") bhtyp = .Cells(i, "G") bhtypneu = .Cells(i, "N") sachnummer = .Cells(i, "D") menge = .Cells(i, "F").Value ' Menge aus Spalte F teiler = .Cells(i, "M").Value vereinzelteZeilen = Application.WorksheetFunction.Max(1, menge / teiler) ' Anzahl der vereinzelten Zeilen End With For j = 0 To vereinzelteZeilen ' Dummy-Eintrag arr1(1, 3) = huNummer + j If j = 0 Then arr1(1, 4) = "Dummy" arr1(1, 6) = 0 arr1(1, 7) = bhtyp arr1(1, 12) = "" Else arr1(1, 4) = sachnummer arr1(1, 6) = 0 arr1(1, 6) = teiler arr1(1, 7) = bhtypneu arr1(1, 12) = huNummer End If wsVereinzelt.Cells(dummyRow + j, "A").Resize(, 12) = arr1 ' huNummer = huNummer + 1 ' Erhöhe HU-Nummer Next j dummyRow = dummyRow + j huNummer = arr1(1, 3) Next i End Sub

Hallo Ulf

Ich hatte auch ein Makro angefangen und darin die Restmengen / Mindermengen dort schon berücksichtigt.

Deshalb hier meine Lösung.

Sub DatenVereinzeln()

    Dim wsMaster As Worksheet, wsVereinzelt As Worksheet

    Dim lastRow As Long, i As Long, dummyRow As Long

    Dim menge As Long, einzelMenge As Long, rest As Long

    Dim zZeile As Long, vereinzelteZeilen As Long

    

    ' Setze Arbeitsblätter

    Set wsMaster = ThisWorkbook.Sheets("MasterHU")

    Set wsVereinzelt = ThisWorkbook.Sheets("Vereinzelt")

    

    ' Lösche vorhandene Daten auf dem Blatt "Vereinzelt"

    wsVereinzelt.UsedRange.Clear

    

    ' Finde die letzte Zeile im MasterHU

    lastRow = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row

    

    ' Kopiere die Überschrift und Daten

    wsMaster.Range("A1:L1").Copy wsVereinzelt.Range("A1")

    

    ' Durchlaufe die Zeilen im MasterHU-Blatt

    For i = 2 To lastRow

        menge = wsMaster.Cells(i, "F") ' Menge aus Spalte F

        einzelMenge = wsMaster.Cells(i, "M")

        vereinzelteZeilen = Application.WorksheetFunction.Max(1, menge / einzelMenge) ' Anzahl der vereinzelten Zeilen

        rest = menge Mod einzelMenge

        zZeile = IIf(rest > 0 And menge > einzelMenge, 1, 0) 'Zusatzeile bei Rest

        

        ' Dummy-Eintrag

        With wsVereinzelt

            dummyRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 'erste Leerzeile

            wsMaster.Cells(i, "A").Resize(1, 11).Copy .Cells(dummyRow, "A").Resize(vereinzelteZeilen + zZeile + 1, 11) 'Zeilen vervielfachen

            .Cells(dummyRow, "D") = "Dummy"

            .Cells(dummyRow, "F") = 0

        

            'Neunummerierung HU

            With .Cells(dummyRow, "c").Resize(vereinzelteZeilen + zZeile + 1, 1)

                .FormulaR1C1 = "=ROW(R[" & -dummyRow + 1 & "]C)"

                .Value = .Value 'Formel in Werte

            End With

            

            .Cells(dummyRow + 1, "F").Resize(vereinzelteZeilen + zZeile, 1) = Application.Min(menge, einzelMenge) 'Menge

            

            'Zusatzzeile bei Restmenge

            If zZeile > 0 Then .Cells(dummyRow + vereinzelteZeilen + 1, "F") = rest

            

            .Cells(dummyRow + 1, "G").Resize(vereinzelteZeilen + zZeile, 1) = wsMaster.Cells(i, "N") 'Behälter

            .Cells(dummyRow + 1, "L").Resize(vereinzelteZeilen + zZeile, 1) = wsMaster.Cells(i, "C") 'Master HU



        End With

    Next i

End Sub

LG UweD

'Neunummerierung HU With .Cells(dummyRow, "c").Resize(vereinzelteZeilen + zZeile + 1, 1) .FormulaR1C1 = "=ROW()-1" .Value = .Value 'Formel in Werte End With

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen vereinzeln

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread