Office: Liste von Werten mit zwei Bedingungen verlängern, zeilenabhängige Duplikate erzeugen

JanFr · 7. Februar 2020

eine letzte Frage hätte ich noch dazu..

ich habe in der besagten Anfangstabelle Formeln statt werten, VBA funtkioniert einwandfrei, aber er rechnet in jeder Schleife neu und dadurch dauert es einige Zeit. Gibt es noch einen Trick, wie man es beschleunigen könnte?

Scorefun · 7. Februar 2020

Berechnungsoptionen vorher auf manuell setzen

Code:

Application.Calculation = xlManual

...Dein Code

Application.Calculation = xlAutomatic
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

EarlFred · 7. Februar 2020

\@Ralf
bitte keine Einstellungen ändern, ohne sie auf den Ursprungswert zurückzusetzen:
Code:

Option Explicit

Sub Aufteilen()
Dim lngLetzte As Long
Dim lngEinfüg As Long
Dim i As Long
Dim dblMaxKapa As Double
Dim lngAnzZeilen As Long
Dim fVarProd As Variant
Dim lngStück As Long
Dim lngFormen As Long
Dim lngCalcStatus As Long

On Error GoTo ErrExit

lngCalcStatus = Application.Calculation
Application.Calculation = xlCalculationManual

With Worksheets("F7 Artikelebene")
dblMaxKapa = .Cells(2, "Y").Value
lngLetzte = .Cells(.Rows.Count, "W").End(xlUp).Row

For i = 5 To lngLetzte
If .Cells(i, "W").Value "" Then
fVarProd = .Cells(i, "W").Resize(, 2).Value
lngStück = .Cells(i, "Y").Value
lngFormen = .Cells(i, "AA").Value

lngAnzZeilen = Application.Min(lngFormen, Application.RoundUp(lngStück / dblMaxKapa, 0))

With Worksheets("F7 Soll")
lngEinfüg = Application.Max(8, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
With .Cells(lngEinfüg, 1)
.Resize(lngAnzZeilen, 2).Value = fVarProd
.Offset(, 2).Resize(lngAnzZeilen).Value = lngStück / lngAnzZeilen
End With
End With

End If
Next i

End With

ErrExit:
Application.Calculation = lngCalcStatus
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Scorefun · 7. Februar 2020

*Smilie Hast ja recht...

JanFr · 7. Februar 2020

einfach klasse!

Danke schön *top *top

JanFr · 10. Februar 2020

Hi nochmal,

wie müsste ich den Code hier verändern:

With .Cells(lngEinfüg, 1)
.Resize(lngAnzZeilen, 2).Value = fVarProd
.Offset(, 2).Resize(lngAnzZeilen).Value = lngStück / lngAnzZeilen

wenn ich die Stückzahl nicht gleich verteilt über die Formen, sondern, erst

maximal mit $Y$2 (44,1) und dann den Rest verteilt haben würde wollen?

bei Stückzahlen, die größer als die Gesamtkapa Formenanzahl x 44, 1 ($Y$2) müsste die Gleichverteilung bleiben...

Beispiel siehe Datei

Gruss

EarlFred · 10. Februar 2020

Vorsatz:

wollte generell das Grundgerüst zur weiteren Bearbeitung haben.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Umsetzung:

wie müsste ich den Code hier verändern
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Zeit, die du beim Nachdenken über die Aufgabe sparst, zahlen wir doppelt drauf. Die Bedingung hätte dir vorher klar sein müssen, vor allem, da wir mehrfach nachgefragt haben.

Hier geht's weiter:

wenn ich die Stückzahl nicht gleich verteilt über die Formen, sondern, erst

maximal mit $Y$2 (44,1) und dann den Rest verteilt haben würde wollen?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

NOCH unpräziser kannst du es nicht beschreiben?

xlsm-Dateien öffne ist nicht. Da muss sich ein anderer vergnügen.

EarlFred · 10. Februar 2020

Alles Handwerkszeug, was du brauchst, war schon im Code vorhanden. Es lag also an dir, dich mit dem Code zu beschäftigen und ihn zu verstehen. Dann hättest du das auch alleine hinbekommen.

Letzte Hilfestellung meinerseits:
Code:

Option Explicit

Sub Aufteilen()
Dim lngLetzte As Long
Dim lngEinfüg As Long
Dim i As Long
Dim dblMaxKapa As Double
Dim lngAnzZeilen As Long
Dim fVarProd As Variant
Dim lngStück As Long
Dim lngFormen As Long
Dim lngCalcStatus As Long
Dim dblAufgeteilt As Double

On Error GoTo ErrExit

lngCalcStatus = Application.Calculation
Application.Calculation = xlCalculationManual

With Worksheets("F7 Artikelebene")
dblMaxKapa = .Cells(2, "Y").Value
lngLetzte = .Cells(.Rows.Count, "W").End(xlUp).Row

For i = 5 To lngLetzte
If .Cells(i, "W").Value "" Then
fVarProd = .Cells(i, "W").Resize(, 2).Value
lngStück = .Cells(i, "Y").Value
lngFormen = .Cells(i, "AA").Value

lngAnzZeilen = Application.Min(lngFormen, Application.RoundUp(lngStück / dblMaxKapa, 0))

With Worksheets("F7 Soll")
lngEinfüg = Application.Max(8, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
With .Cells(lngEinfüg, 1)
.Resize(lngAnzZeilen, 2).Value = fVarProd
.Offset(, 2).Resize(lngAnzZeilen).Value = Application.Min(dblMaxKapa, lngStück / lngAnzZeilen)
dblAufgeteilt = (lngAnzZeilen - 1) * Application.Min(dblMaxKapa, lngStück / lngAnzZeilen)
.Offset(lngAnzZeilen - 1, 2).Value = lngStück - dblAufgeteilt
End With
End With

End If
Next i

End With

ErrExit:
Application.Calculation = lngCalcStatus
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

JanFr · 10. Februar 2020

Vielen Dank, habe den code gelesen, aber er gibt noch nicht das aus, was ich meinte. Habe mich anscheinend zu ungenau ausgedrückt, in der Beispieldatei ist es deutlicher. Wusste das mit den Makrodateien nicht, sorry...

EarlFred · 10. Februar 2020

Wie wär's, wenn du den Code ab sofort selbst bearbeitest, wie du es großspurig angekündigt hast?

habe den code gelesen
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Lesen allein reicht nicht, da musst du den Code dann schon verstehen. Aber dabei lernst du dann wenigstens was - und wenn es Respekt ist, dass man die Aufgabe zu Beginn ordentlich beschreibt und nicht unterwegs alles über den Haufen wirft.

JanFr · 11. Februar 2020

Hi,

ich habe es nicht großspurig behauptet, dass ich es in VBA weiter bearbeiten möchte. Ich bearbeite es weiter mit Formeln, was ich auch tue.
Teile es Codes verstehe ich, bin aber auch kein Profi, daher suche ich hier ja nach Hilfe.

was ich an diesem Teil nicht verstehe,

.Offset(, 2).Resize(lngAnzZeilen).Value = Application.Min(dblMaxKapa, lngStück / lngAnzZeilen)

ist, warum er da nicht 44,1 schreibt, denn dblAufgeteilt stellt ja den Rest dar.

dblAufgeteilt = (lngAnzZeilen - 1) * Application.Min(dblMaxKapa, lngStück / lngAnzZeilen)
.Offset(lngAnzZeilen - 1, 2).Value = lngStück - dblAufgeteilt

Office: Liste von Werten mit zwei Bedingungen verlängern, zeilenabhängige Duplikate erzeugen

Liste von Werten mit zwei Bedingungen verlängern, zeilenabhängige Duplikate erzeugen

Liste von Werten mit zwei Bedingungen verlängern, zeilenabhängige Duplikate erzeugen

Liste von Werten mit zwei Bedingungen verlängern, zeilenabhängige Duplikate erzeugen

Liste von Werten mit zwei Bedingungen verlängern, zeilenabhängige Duplikate erzeugen

Liste von Werten mit zwei Bedingungen verlängern, zeilenabhängige Duplikate erzeugen - Similar Threads - Liste Werten Bedingungen

SQL: Filtern mit mehreren Werten aus einer Excelspalte (Liste)

Wert einer Zelle neben einer anderen Zelle automatisch anzeigen

Wert in Liste mit mehreren Namen berechnen

Wenn Datum heute dann Wert aus andere Liste anzeigen

Bestimmte Werte zählen und absteigend in Liste ausgeben

Zellen verbinden bei bestimmtem Wert aus Dropdown-Liste

Größte Werte aus Liste mit Bedingung