Office: Excel

BenediktUS · 16. August 2017

Hallo zusammen,

leider bin ich bei meiner Recherche in keinen der mir bekannten Foren/You-Tutorials zu einer für mich passenden Lösung gekommen.

Daher meine große Hoffnung, dass mir jemand von euch weiterhelfen kann und diese Problemlösung dann auch nachfolgenden Excel-Usern einen Vorteil bringt.

Also mein Problem ist,...ich habe eine Tabelle "DS" welche ich aus einer Datenbank rausziehe (daher mit Name "TabelleTest" deklariert und schon automatischen Filter versehen), welche ich aufgrund einer hinzugefügten Spalte "Berücksichtigen" (welche sich automatisch berechnet sobald die Daten aktualisiert werden) unterscheiden mag mit "Ja" oder "Nein".

Das Makro soll nun alle Zeilen der Tabelle durchlaufen, wobei die Zeilen welche mit "Ja" deklariert sind im Originalzustand in ein neues Tabellenblatt "DS korrigiert" eingefügt werden sollen. (denke ich sollte ich mit Makro-Aufzeichnungs-Rekorder hinbekommen *watch

Wenn jedoch ein "Nein" für diese Zeile hinterlegt ist,...soll aus der Spalte "Stelle" der Wert gezogen werden (z.B. 6,7,8,9,10,11,12) welcher dann in einer weiteren Tabelle auf dem Arbeitsblatt "Parameter" überprüft werden kann, auf Basis der Spalte "Anzahl" Ausschluss gibt wie häufig die Zeile in das Arbeitsblatt "DS korrigiert" eingefügt werden soll. Zum Beispiel wenn ursprünglich die Stelle 6 hinterlegt wurde, muss aus der einen Zeilen in der Originaltabelle 5 Zeilen in der korrigierten Version entstehen. Wobei dann auf Basis der Anteile in den Spalten 1,2,3,4,5 der Wert in Spalte "Zeit" entsprechend aufgeteilt wird. (in Beispieldatei auf Tabellenblatt "Beschreibung" habe ich mal versucht es darzustellen was quasi aus der 1 Zeile mit Stelle 6 im Originalzustand, in der neu angelegten korrigierten Version werden soll).

Ich hoffe irgendjemand auf die großen Welt liest diesen Beitrag und kann mir weiterhelfen...Tausend Dank im Voraus und allen die meinen Beitrag gelesen haben, schon mal einen guten Start ins Wochenende.*Smilie

Liebe Grüße Benedikt

:)

BenediktUS · 22. August 2017

Hat wirklich niemand eine Idee? Bzw. schon mal eine ähnliche Thematik gehabt oder gesehen? :-(

Jonas0806 · 22. August 2017

Hallo Benedikt,

zeig uns doch mal den Code, den Du bisher hast.

BenediktUS · 23. August 2017

Hi Jonas,

anbei mein bisheriger Code...der wie oben beschrieben noch ausbaufähig ist.
Also was bisher funktioniert....ist das stupide Kopieren der Zeilen je nach Kriterium.

Nun müsste ich ja aber im Nein-Fall irgendwie die Anzahl regeln wie oft, die ausgewählte Zeile kopiert werden sollte. (Da könnte ich mir vorstellen das ich diese Information per VLookUp aus dem Arbeitsblatt "Parameter" bekomme...leider weiß ich nicht wie der VLookUp-Befehl aussehen sollte, wenn ich keine fixe Zelle anspreche. Mit diesem rückgegebenen Wert, müsste ich dann nur noch den Copy-Befehl entsprechend anpassen (Was ich bisher auch noch nicht weiß :-( ). Außerdem müsste ja auch noch die entsprechende Anpassung der Spalte B,C ais der Originalzeile gemäß des Parameter-Tabellenblatt dem Copy-Befehl vorausgehen.

Ich hoffe du verstehst mein Problem...und kannst mir eine hilfreiche Antwort liefern. Vielen Dank für deine Mühe

Code:

Public Sub CopyRows()
Dim CopyCounter
Sheets("DS").Select
' Find the last row of data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column D
ThisValue = Cells(x, 4).Value
If ThisValue = "Ja" Then
Cells(x, 1).Resize(1, 33).Copy
Sheets("DS korrigiert").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("DS").Select
Application.CutCopyMode = False
ElseIf ThisValue = "Nein" Then
'CopyCounter = Application.WorksheetFunction.VLookup(Sheets("DS").(Cells(x,1).Value),Sheets("Parameter").Range("A2:B8"), 2,False)
Cells(x, 1).Resize(1, 33).Copy
Sheets("Tabelle1").Select
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(NextRow, 1).Select
ActiveSheet.Paste
Sheets("DS").Select
Application.CutCopyMode = False
End If
Next x
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Jonas0806 · 23. August 2017

Hallo Benedikt,

meinst Du das so?

Code:

Option Explicit

Public Sub CopyRows()
Dim i As Long
Dim arr
Dim dic As Object

With Worksheets("DS")
arr = .Range(Cells(2, 1), Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4))
End With

Set dic = CreateObject("scripting.dictionary")

For i = LBound(arr) To UBound(arr)
If arr(i, 4) = "Ja" Then
If dic.exists(arr(i, 2)) Then
If dic(arr(i, 2)) < WorksheetFunction.VLookup(arr(i, 2), Worksheets("Parameter").UsedRange, 2, 0) Then
With Worksheets("DS korrigiert")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 4) = Application.Index(arr, i)
End With
dic(arr(i, 2)) = dic(arr(i, 2)) + 1
End If
Else
dic.Add arr(i, 2), 1
With Worksheets("DS korrigiert")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 4) = Application.Index(arr, i)
End With
End If
ElseIf arr(i, 4) = "Nein" Then
'In anderes Blatt koieren?
Else
'Nich definiert
End If
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

BenediktUS · 24. August 2017

Hi Jonas,

und vielen Dank für deine schnelle Antwort.

Leider funktioniert das ganze noch nicht so...wie es sollte.

Also es kopiert zwar die jeweilig bedingten Werte (Welche "Ja" oder "Nein" sind - habe es in der angehangenen Beispieldatei mal getauscht, weil ich dachte festgestellt zu haben, dass die "Ja" - Zeilen aufgrund der Parameter - Tabelle bei einem Versuch dupliziert wurden).

Code:

Option Explicit

Public Sub CopyRows2()
Dim i As Long
Dim arr
Dim dic As Object

With Worksheets("DS")
arr = .Range(Cells(2, 1), Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4))
End With

Set dic = CreateObject("scripting.dictionary")

For i = LBound(arr) To UBound(arr)
If arr(i, 4) = "Nein" Then
If dic.exists(arr(i, 2)) Then
If dic(arr(i, 2)) < WorksheetFunction.VLookup(arr(i, 2), Worksheets("Parameter").UsedRange, 2, 0) Then
With Worksheets("DS korrigiert")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 4) = Application.Index(arr, i)
End With
dic(arr(i, 2)) = dic(arr(i, 2)) + 1
End If
Else
dic.Add arr(i, 2), 1
With Worksheets("DS korrigiert")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 4) = Application.Index(arr, i)
End With
End If
ElseIf arr(i, 4) = "Ja" Then
With Worksheets("DS korrigiert")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 4) = Application.Index(arr, i)
End With
'In anderes Blatt koieren?
Else
'Nich definiert
End If
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aber leider nur die voher auch schon da waren, bzw. eine Zeile (13) wird nicht übernommen ("2017-07-14 9 100 Nein").

Also ich weiß nicht so recht weiter woran das liegen kann, wie gesagt Ziel ist es dass ich alle Zeilen die mit "Ja" in Spalte D auf Tabellenblatt "DS" vorliegen in die nächste freie Zeile auf Tabellenblatt "DS korrigiert" komplett kopiert werden. Für alle Zeilen von Tabellenblatt "DS" mit dem "Nein" in Spalte D soll nicht nur eine Kopie in die nächste leere Zeile auf Tabellenblatt "DS korrigiert" eingefügt werden, sondern wenn in der Ursprungszelle in Spalte B die Stelle 6 steht, in das Tabellenblatt "Parameter" - Spalte A geschaut werden und wahrscheinlich mit einem SVerweis-ähnlichen Befehl (Deswegen dachte ich VLookUp) die Anzahl aus Spalte B herausgefunden werden und entsprechend dieser Anzahl X-mal die Ursprungszeile aus Tabellenblatt "DS" in die nächste leere Zeile "DS korrigiert" eingefügt werden.

Wobei dies noch nicht das "Wunschende" wäre, sondern ich würde in den X-Kopiezeilen aus "DS" beim Einfügen der jeweiligen Zeile gern den Ursprungswert aus "DS" für die Spalte "B" entsprechend der Tabelle im Blatt "Parameter" D2:H8, wenn der Wert größer 0 ist ändern.

Also z.B. aus der ursprünglichen Zeile in "DS"
Datum = Zelle A1
Stelle = Zelle B1
Zeit = Zelle C1
Berücksichtigen = D1
2017-05-10 = Wert in Zelle A3
6 = Wert in Zelle B3
20 = Wert in Zelle C3
Nein = Wert in Zelle D3

aufgrund der Tabelle in "Parameter" welche für die Stelle "6" in Zelle B2 vorgibt dass es 5 neue Zeilen in "DS korrigiert" geben soll,
soll dementsprechend in "DS korrigiert" die erste erzeugte Zeile daraus wie folgt aussehen.

Datum - "2017-05-10" (wird einfach kopiert aus Originalzeile in "DS")
Stelle - "1" (da in der Tabelle auf Tabellenblatt "Parameter" der Wert in Spalte D größer als 0 ist)
Zeit - "4" (da in der Tabelle auf Tabellenblatt "Parameter der Wert in Spalte D 20 ist --> 20 % von 20 sind 4)
Berücksichtigen - "Ja2" (um in der Endfassung zu unterscheiden wieviel Original waren und wieviel umgerechnet wurden)

die zweite erzeugte Zeile daraus sollte demnach so aussehen....
Datum - "2017-05-10" (wird einfach kopiert aus Originalzeile in "DS")
Stelle - "2" (da in der Tabelle auf Tabellenblatt "Parameter" der Wert in Spalte D größer als 0 ist)
Zeit - "6" (da in der Tabelle auf Tabellenblatt "Parameter der Wert in Spalte D 30 ist --> 30 % von 20 sind 6)
Berücksichtigen - "Ja2"

...usw.

Ich hoffe meine Erklärung macht dir es einfacher, mir evtl. weiterhelfen zu können.
Auf jeden Fall vielen Dank erstmal für die tolle Hilfe bisher. In der Hoffnung ich habe dich jetzt nicht entmutigt...

Jonas0806 · 24. August 2017

Hallo Benedikt,

2 Dinge.

1. Bitte lade die Datei als *.xlsx hoch und stelle eventuell relevanten Code in Code-Tags zu Verfügung.

2. Erstelle bitte eine Datei, inwelcher Du das gewünschte Ergebnis im Sheet wo es hin soll einmal händisch eingetragen hast. Das Sheet Beschreibung kannst Du weglassen. Achte außerdem bitte darauf, dass deine Datei exakt den seleben Aufbau hat wie dein Original.

BenediktUS · 24. August 2017

Hi Jonas,

vielen Dank für die Hinweise - werde ich zukünftig berücksichtigen. :-)
Also anbei nun der von dir probierte Code
Code:

Option Explicit

Public Sub CopyRows()
Dim i As Long
Dim arr
Dim dic As Object

With Worksheets("DS")
arr = .Range(Cells(2, 1), Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 4))
End With

Set dic = CreateObject("scripting.dictionary")

For i = LBound(arr) To UBound(arr)
If arr(i, 4) = "Nein" Then
If dic.exists(arr(i, 2)) Then
If dic(arr(i, 2)) < WorksheetFunction.VLookup(arr(i, 2), Worksheets("Parameter").UsedRange, 2, 0) Then
With Worksheets("DS korrigiert")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 4) = Application.Index(arr, i)
End With
dic(arr(i, 2)) = dic(arr(i, 2)) + 1
End If
Else
dic.Add arr(i, 2), 1
With Worksheets("DS korrigiert")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 4) = Application.Index(arr, i)
End With
End If
ElseIf arr(i, 4) = "Ja" Then
With Worksheets("DS korrigiert")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 4) = Application.Index(arr, i)
End With
'In anderes Blatt koieren?
Else
'Nich definiert
End If
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

So hoffentlich kannst du oder ein anderer mir jetzt doch noch weiterhelfen

Office: Excel

Excel

Excel

Excel

Excel

Excel - Similar Threads - Excel

Name der Datei durch Excel geändert

Hochzählen Zelle Excel oder Office365?

Zugriff auf nicht vorhandene Datei seitens Excel

pdf drucken mit button in excel einfügen

Excel icon fehlt

Excel Tabellenblatt als PDF speichern unter Vorgabe Dateinamen aus einer Zelle

VBA: Platzhalter ersetzen und evtl. leere Zeile einfügen