Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.05.2024 11:17:06
Hyperlink zu Bild in Zelle
17.05.2024 11:15:40
Spalte und Makros gleichzeitig verschieben
17.05.2024 11:03:10
Ganze Zahl in Ganz-Zahl Kombinationen aufteilen (ohne Rest)
17.05.2024 10:40:53
Tabellen (formatiert) über VBA auswählen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1956to1960
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1956to1960
1956to1960
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

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


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

Links zu Excel-Dialogen

Frame

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige