Live-Forum - Die aktuellen Beiträge
Datum
Titel
13.10.2025 19:31:31
VBA Formel mit Bezug auf Überschrift anstatt Spalte
13.10.2025 15:10:17
Überlappende Zeiträume über mehrere Tabellen mit leeren Zell
13.10.2025 13:34:56
PQ Abfrage mit verschiedenen Werten ausführen + Protokoll
13.10.2025 12:24:02
Zählen in Abhängigkeit einer Jahreszahl
Keine passende Antwort im Forumarchiv gefunden?
Stelle deine Frage im Live-Forum
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1956to1960
1956to1960
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

aus 5 mach 5x1

Forumthread: aus 5 mach 5x1

aus 5 mach 5x1
04.01.2024 15:05:01
Tsubasa
Hallo Zusammen,

ich bräuchte dringend Hilfe, ich habe eine Tabelle... Material, Datum & Menge...

https://www.herber.de/bbs/user/165892.xlsx

Wenn Material = 5, dann bräuchte ich die Materialnummer 5x untereinander und immer mit Menge 1...

Entschuldigt bitte für dies Durcheinander, Bsp.-Tabelle ist angehängt... :-)
Gelb markiert ist einmal ein Bsp. wie es aussehen sollte... FYI, es sind rd. 180 Materialnummern und ca. 24x ein Datum, sprich die Tabelle ist recht groß...

BG


Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: aus 5 mach 5x1
04.01.2024 16:16:15
Yal
Hallo Martin,

mit diesem Code sollte es gehen. Auf dem Reiter rechtsklicken, "Code anzeigen" wählen und dorthin Code ablegen.
Prüfe vorher die Parameter. 

Sub Erweitern()

Dim R As Long 'R wie Row, also Zeile

Dim Mem

Dim i



Const cErsteZeile = 3

Const cErsteSpalte = 2

Const cLetzteSpalte = 4



    Application.ScreenUpdating = False

    For R = Range("A99999").End(xlUp).Row To cErsteZeile Step -1  'rückwärts, also von unten

    'Ursprungswert aufnehmen (-1 weil aus 1 dann nichts)

        Mem = WorksheetFunction.Average(Range(Cells(R, cErsteSpalte), Cells(R, cLetzteSpalte))) - 1

    'Werte auf 1 setzen

        For i = cErsteSpalte To cLetzteSpalte

            Cells(R, i).Value = 1

        Next

    'nach Anzahl an Ursprungswert kopieren

        For i = 1 To Mem

            Rows(R).Copy

            Rows(R + 1).Insert Shift:=xlDown

            Application.CutCopyMode = False

        Next

    Next

    Application.ScreenUpdating = True

End Sub


Es geht wahrscheinlich auch mit Power Query.

VG
Yal
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige