Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Wert bestimmt Anzahl der zu kopierenden Zeilen VBA

Wert bestimmt Anzahl der zu kopierenden Zeilen VBA
18.12.2008 13:24:00
Maja
Hallo,
ich Suche eine Formel mit der ich folgenden Code modifizieren kann:

Sub Uebergabe()
Dim i As Integer
Dim k As Integer
Dim iRowT As Integer
Const zz = 1
flagg = False
Sheets("Vorlage_Angebot_Sicht").Activate
Sheets("Vorlage_Angebot_Sicht").Range("D2").Select
i = 0
iRowT = 10
Do Until IsEmpty(ActiveCell)
For i = 0 To zz
ActiveCell.Select
If IsNumeric(Selection.Value) Then
If Selection.Value > 0 Then
Sheets("Eingabe").Cells(iRowT, 2) = ActiveCell.Offset(0, -3).Text
Sheets("Eingabe").Cells(iRowT, 3) = ActiveCell.Offset(0, -2).Text
Sheets("Eingabe").Cells(iRowT, 4) = ActiveCell.Offset(0, -1).Text
iRowT = iRowT + 1
ActiveCell.Offset(1).Select
Else
ActiveCell.Offset(1).Select
End If
Else
ActiveCell.Offset(1).Select
End If
Next i
Loop
End Sub


In der Spalte "D" steht eine Zahl, die zwischen 0 und 100 differieren kann. Nun ist mein Problem, dass nicht nur, wie oben im Code schon geschrieben steht, einfach nur alle Zeilen, wo der der Wert in Spalte "D" > 0 ist, in ein das andere Tabellenblatt "Eingabe" nacheinander kopiert werden sollen. Es soll darüber hinaus auch die Größe der Zahl in Spalte "D" berücksichtigt werden.
Das heißt, wenn in dort eine "1" steht, soll die entsprechende Zeile nur einmal in das Tabellenblatt "Eingabe" kopiert werden. Steht dort aber eine "2" oder "5" soll diese eine Zeile jeweils zwei- bzw. fünfmal in das Tabellenblatt "Eingabe" kopiert werden, bevor die nächste Zeile im Herkunftstabellenblatt nach einem Wert > 0 durchsucht und die entsprechende Zeile wieder nach "Eingabe" kopiert wird.
Wer kann mir hierbei helfen?
Vielen Dank schon einmal im Voraus!

Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wert bestimmt Anzahl der zu kopierenden Zeilen VBA
18.12.2008 15:36:16
fcs
Hallo maja,
hier eine Lösung, wobei ich die unsäglichen "Select" entfernt habe.
Gruß
Franz

Sub Uebergabe()
Dim i As Integer
Dim k As Integer, Zelle As Range
Dim iRowT As Integer
Const zz = 1
flagg = False
Sheets("Vorlage_Angebot_Sicht").Activate
Set Zelle = Sheets("Vorlage_Angebot_Sicht").Range("D2") 'Startzelle
i = 0
iRowT = 10
Do Until IsEmpty(Zelle)
For i = 0 To zz
If IsNumeric(Zelle) Then
If Zelle.Value > 0 Then
For k = 1 To Zelle.Value
Sheets("Eingabe").Cells(iRowT, 2) = Zelle.Offset(0, -3).Text
Sheets("Eingabe").Cells(iRowT, 3) = Zelle.Offset(0, -2).Text
Sheets("Eingabe").Cells(iRowT, 4) = Zelle.Offset(0, -1).Text
iRowT = iRowT + 1
Next
End If
End If
Set Zelle = Zelle.Offset(1)
Next i
Loop
End Sub


Anzeige
AW: Wert bestimmt Anzahl der zu kopierenden Zeilen VBA
18.12.2008 17:03:00
Maja
Vielen Dank, natürlich auch für die Verbesserung meines Codes. Leider bin ich noch auf dem Niveau des "Try and Error", so dass ich heilfroh bin, wenn mein Code überhaupt funktioniert, völlig egal wie umständlich oder redundant er ist! Daher Dankeschön für die lehrreichen Anpassungen.
AW: Wert bestimmt Anzahl der zu kopierenden Zeilen VBA
18.12.2008 15:47:00
Christian
Hallo,
probier mal so...
gruß
Christian

Sub Uebergabe()
Dim i&, j&, k&
k = 10
With Sheets("Vorlage_Angebot_Sicht")
For i = 2 To .Cells(2, 4).End(xlDown).Row
If IsNumeric(.Cells(i, 4).Value) Then
For j = 1 To .Cells(i, 4).Value
Sheets("Eingabe").Cells(k, 2).Resize(1, 3) = .Cells(i, 1).Resize(1, 3).Value
k = k + 1
Next
End If
Next
End With
End Sub


Anzeige
AW: Wert bestimmt Anzahl der zu kopierenden Zeilen VBA
18.12.2008 16:59:00
Maja
Wow, der Code sieht so viel eleganter aus als meiner.
Vielen Dank!!!

Forumthreads zu verwandten Themen

Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

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