Makro um Daten in Liste zu speichern

Hallo liebe VBA-Gemeinde,
meine VBA-Kenntnis beschränken sich auf den Macro-recorder, allerdings benötige ich ein Makro das sich nicht aufzeichnen lässt. Ich verstehe fast nichts vom VBA-Syntax.
Was ich benötige ist an sich sehr einfach. Ich möchte in excel eine Monte-Carlo-Simulation modellieren, also mit Zufallszahlen bestimmte Ergebnisse simulieren. Hierzu sind viele (tausende) Iterationen notwendig.
Das Makro soll also folgendes tun: Das Sheet neu berechnen und dann bestimmte Zellen in ein zweites Sheet (im gleichen file) wegspeichern. Nach jeder Neuberechnung also in einer neuen Zeile. Sagen wir im Ursprungssheet stehen 4 relevante Werte in E4,F4,G4,H4 (oder wo auch immer) und diese sollen dann im Sheet2 in die Spalten A bis D geschrieben werden. Je Neuberechnung in die nächste Zeile
Die Anzahl der Neuberechnungen kann entweder im Makro eingegeben werden oder noch besser wäre ein Bezug zu einer Zelle im Ausgangssheet (sagen wir in Zelle B2) wo ich für jeden Makrolauf die Zahl der Berechnungen/Iterationen definieren kann.
Kann jemand sowas ohne großen Aufwand erzeugen?
Ich nehme an, wenn man das Makro mal hat kann man die Zellen leicht abwandeln!?
Vielen Dank schonmal im Voraus, ich hoffe die Spezifikation ist hinreichend eindeutig.
Gruß,
Economista

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub Auswertung() Dim wksDaten As Worksheet, wksErgebnis As Worksheet Dim Berechnung As Long, Spalte As Long, Zeile As Long, StatusCalc As Long Dim Ergebnis() As Variant On Error GoTo Fehler Set wksDaten = Worksheets("Tabelle1") 'Tabellenblatt mit den Berechnungen Set wksErgebnis = Worksheets("Zielblatt") 'Tabellenblatt mit den Ergebnisse ReDim Ergebnis(1 To 4) '4 = Anzahl der zu übertragenden Werte With Application StatusCalc = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With With wksErgebnis 'Alte Daten im Ergebnisblatt ab Zeile 2 löschen Zeile = .Cells.SpecialCells(xlCellTypeLastCell).Row If Zeile > 1 Then .Range(.Rows(2), .Rows(Zeile)).ClearContents Zeile = 1 'Zeile mit Spaltentiteln End With Berechnung = wksDaten.Range("B2") 'Anzahl der Berechnungen If Berechnung + Zeile > wksErgebnis.Rows.Count Then MsgBox "Ergebnistabelle ist nur ausreichend für " _ & wksErgebnis.Rows.Count - Zeile & " Berechnungen", _ vbInformation + vbOKOnly, "Anzahl Berechnungen zu groß" GoTo Beenden End If For Berechnung = 1 To Berechnung 'Datenblatt neu berechnen Application.Calculate 'Ergebnisse einlesen Ergebnis(1) = wksDaten.Range("E4").Value Ergebnis(2) = wksDaten.Range("F4").Value Ergebnis(3) = wksDaten.Range("G4").Value Ergebnis(4) = wksDaten.Range("H4").Value 'Ergebniswerte in Zielblatt übertragen Zeile = Zeile + 1 With wksErgebnis .Cells(Zeile, 1).Value = Berechnung For Spalte = 1 To UBound(Ergebnis) .Cells(Zeile, Spalte + 1).Value = Ergebnis(Spalte) Next End With Next Berechnung MsgBox "Fertig" Fehler: With Err Select Case .Number Case 0 'kein Fehler Case 6 MsgBox "Der Eingabewert für die Anzahl der Berechnungen ist zu hoch" Case Else MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description End Select End With Beenden: With Application .Calculation = StatusCalc .ScreenUpdating = True .EnableEvents = True End With Set wksDaten = Nothing: Set wksErgebnis = Nothing Erase Ergebnis End Sub

Hi Franz,
dien Makro interessiert mich auch. Habe etwas angepasst (s. FETT). Ich möchte, dass 6 Spalten berechnet und auch eingetragen werden. Die Berechnung funtioniert schon. kann in dem Makro nicht erkennen, wie ich die 6 Spalten auch in der Tabelle "Ergebnis" in 6 Spalten eingetragen bekomme.
Wäre nett, wenn Du mir da helfen kannst.
Danke für evtl. Hilfe und
Gruß
Dieter(Drummer)


Sub Auswertung()
Dim wksDaten As Worksheet, wksErgebnis As Worksheet
Dim Berechnung As Long, Spalte As Long, Zeile As Long, StatusCalc As Long
Dim Ergebnis() As Variant
On Error GoTo Fehler
Set wksDaten = Worksheets("Tabelle1")     'Tabellenblatt mit den Berechnungen
Set wksErgebnis = Worksheets("Zielblatt") 'Tabellenblatt mit den Ergebnisse
ReDim Ergebnis(1 To 6)  '6 = Anzahl der zu übertragenden Werte
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
With wksErgebnis
'Alte Daten im Ergebnisblatt ab Zeile 2 löschen
Zeile = .Cells.SpecialCells(xlCellTypeLastCell).Row
If Zeile > 1 Then .Range(.Rows(2), .Rows(Zeile)).ClearContents
Zeile = 1 'Zeile mit Spaltentiteln
End With
Berechnung = wksDaten.Range("B2") 'Anzahl der Berechnungen
If Berechnung + Zeile > wksErgebnis.Rows.Count Then
MsgBox "Ergebnistabelle ist nur ausreichend für " _
& wksErgebnis.Rows.Count - Zeile & " Berechnungen", _
vbInformation + vbOKOnly, "Anzahl Berechnungen zu groß"
GoTo Beenden
End If
For Berechnung = 1 To Berechnung
'Datenblatt neu berechnen
Application.Calculate
'Ergebnisse einlesen
Ergebnis(1) = wksDaten.Range("E4").Value
Ergebnis(2) = wksDaten.Range("F4").Value
Ergebnis(3) = wksDaten.Range("G4").Value
Ergebnis(4) = wksDaten.Range("H4").Value
 Ergebnis(4) = wksDaten.Range("I4").Value
Ergebnis(4) = wksDaten.Range("J4").Value
'Ergebniswerte in Zielblatt übertragen
Zeile = Zeile + 1
With wksErgebnis
.Cells(Zeile, 1).Value = Berechnung
For Spalte = 1 To UBound(Ergebnis)
.Cells(Zeile, Spalte + 1).Value = Ergebnis(Spalte)
Next
End With
Next Berechnung
MsgBox "Fertig"
Fehler:
With Err
Select Case .Number
Case 0 'kein Fehler
Case 6
MsgBox "Der Eingabewert für die Anzahl der Berechnungen ist zu hoch"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
Beenden:
With Application
.Calculation = StatusCalc
.ScreenUpdating = True
.EnableEvents = True
End With
Set wksDaten = Nothing: Set wksErgebnis = Nothing
Erase Ergebnis
End Sub

Beliebteste Forumthreads (12 Monate)

Makro um Daten in Liste zu speichern

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread