Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1340to1344
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
Inhaltsverzeichnis

VBA Iteration für n Unternehmen

VBA Iteration für n Unternehmen
26.12.2013 17:53:46
Merton
Hallo zusammen,
ich habe ein Makro geschrieben, welches den gesuchten Wert über eine Periode von 13 Monaten iterativ berechnet.
In Spalte I15:I27 werden als Startpunkt der Iteration zunächst geschätzte Werte eingetragen, die bereits gegeben sind. Schließlich werden die geschätzten Werte über in der Spalte J15:J27 enthaltene Formeln angenähert. Die in Spalte J enthaltenen Formeln beziehen sich dabei auf die geschätzten Werte aus Spalte i.
Die Aufgabe meines Makros ist es nun, die in Spalte J angenäherten Werte so lange in Spalte I zu kopieren, bis „K27“ (SUMMEXMY2(I15:I27;J15:J27)) kleiner als 10^-10 ist.
Das Makro sieht wie folgt aus:

Sub Iterate()
Do While Range("K27") > 10 ^ -10
'Copy asset values from iteration k+1 to iteration k
Range("I15:I27") = (Range("J15:J27"))
Loop
End Sub

Dieses Makro funktioniert einwandfrei. Allerdings kann man damit den gesuchten Wert nur für ein einziges Unternehmen mit 13 Perioden berechnen. Ich möchte den gesuchten Wert jedoch für 800 Unternehmen berechnen. Dabei sind für jedes Unternehmen genau 13 Werte in Spalte I gegeben, welche direkt untereinander aufgelistet werden.
Würde ich den VBA Code für jedes Unternehmen manuell eingeben, dann müsste er für das zweite Unternehmen der Liste wie folgt lauten:

Sub Iterate()
Do While Range("K40") > 10 ^ -10
'Copy asset values from iteration k+1 to iteration k
Range("I28:I40") = (Range("J28:J40"))
Loop
End Sub

Da ich den Code jedoch nicht für 800 Unternehmen manuell eingeben möchte suche ich nun ein Makro, welches mir diese Arbeit erspart.
Ich bin absoluter VBA Neuling und würde mich daher über jegliche Hilfe sehr freuen!
Vielen Dank im Voraus!
Merton

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Iteration für n Unternehmen
26.12.2013 18:55:59
Uduuh
Hallo,
einfach eine Schleife drumrum.
Sub Iterate()
Dim i As Long
For i = 1 To 800
Do While Cells(i * 13 + 14, 11) > 10 ^ -10
'Copy asset values from iteration k+1 to iteration k
Range(Cells(i * 13 + 2, 9), Cells(i * 13 + 14, 9)) = _
Range(Cells(i * 13 + 2, 10), Cells(i * 13 + 14, 10))
Loop
Next i
End Sub
Gruß aus’m Pott
Udo

AW: VBA Iteration für n Unternehmen
26.12.2013 19:01:33
fcs
Hallo Merton,
das kann man in einer For-Next-Schleife mit 13er Schritten realisieren.
Die Prüfung auf Fehler und Anzahl Iterationen hab ich eingebaut, damit das Makro aus einem Fehler herauskommt und nicht in eine Endlosschleife läuft.
Gruß
Franz
Sub Iterate()
Dim lngZeile As Long, k As Long
Dim wks As Worksheet
Set wks = ActiveSheet
On Error GoTo NextBlock
With wks
'Zeilen bis zur letzten Zeile in Spalte J in 13er-Schritten abarbeiten
For lngZeile = 15 To .Cells(.Rows.Count, 10).End(xlUp).Row Step 13
k = 0
'Wert in Spalte K in letzter Zeile des Blocks prüfen
Do While .Cells(lngZeile + 12, 11).Value > 10 ^ -10
k = k + 1
'Copy asset values from iteration k+1 to iteration k
.Range(.Cells(lngZeile, 9), .Cells(lngZeile + 12, 9)).Value = _
.Range(.Cells(lngZeile, 10), .Cells(lngZeile + 12, 10)).Value
.Range(.Cells(lngZeile, 10), .Cells(lngZeile + 12, 11)).Calculate
If k > 10000 Then 'Wert 10000 ggf. vergrößern, wenn die Meldung ständig kommt
MsgBox "in Zeile " & lngZeile _
& " wurde die Iteration nach 10000 Do-Schleifen abgebrochen!"
Exit Do
End If
Loop
'      MsgBox "Anzahl Iterationen: " & k 'Testzeile
NextBlock:
Err.Clear
Next
End With
End Sub

Anzeige
AW: VBA Iteration für n Unternehmen
28.12.2013 23:38:28
Merton
Hallo zusammen!
vielen vielen Dank für eure tollen Antworten. Das hat mir wirklich unglaublich weitergeholfen. Mein Excel Sheet funktioniert jetzt dank der Hilfe von Franz einwandfrei!
Vielen vielen Dank! Das war sehr nett und vor allem hilfreich!
Beste Grüße
Merton

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige