vba Schleife mit "Countdown" für Abschlussarbeit
07.02.2018 13:15:27
Thomas
ich arbeite gerade für meine Masterarbeit an einer Monte-Carlo-Simulation und würde eure fachkundige Hilfe benötigen.
Den Code für MCS habe ich bereits geschrieben. Funktioniert einwandfrei (bin aber für Verbesserungsvorschläge dankbar, muss die Schleife teilweise sehr häufig wiederholen).
Jetzt möchte ich in die bestehende Einfache For-Schleifen eine weitere integrieren.
Und da steh ich momentan auf der Leitung. :D
Diese Soll auf das Tabellenblatt (Tabelle 1) zugreifen und in Zelle C2 soll von 100 - 0 gezählt werden. Damit die Zufallszahlen in Spalte B bei jeder Neuberechnung beeinflusst werden. Das "Programm" starten Ihr im Tabellenblatt (Ergebnisse)
File:
https://www.herber.de/bbs/user/119624.xlsm
Code:
Sub Filter_Simulation()
Dim lngLastRowSi As Long
Dim lngLastRowAw As Long
Dim lngLastRowEg As Long
Dim i As Integer
Dim i2 As Variant
lngLastRowSi = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowAw = Sheets("Auswertung").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowEg = Sheets("Ergebnisse").Cells(Rows.Count, 1).End(xlUp).Row
i2 = InputBox("Wie oft soll kopiert werden?")
If i2 = 0 Or i2 = " " Then Exit Sub
For i = 1 To i2
Application.Calculate
lngLastRowEg = Sheets("Ergebnisse").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowDi = Sheets("Ergebnisse").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Tabelle1").Range("A1:B" & lngLastRowSi).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Auswertung").Range("A1:B" & lngLastRowAw), CopyToRange:=Sheets(" _
_
Ergebnisse").Range("A" & lngLastRowEg + 1), _
Unique:=False
Sheets("Ergebnisse").Rows(lngLastRowDi).Delete
'Sheets("Simulation").Range("DL1:EI" & lngLastRowSi).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Auswertung").Range("A1:X" & lngLastRowAw), CopyToRange:=Sheets(" _
_
Ergebnisse").Range("A" & lngLastRowEg + 1), _
Unique:=False
Next i
Range("B1").Select
'lngLastRowEg = Sheets("Ergebnisse").Cells(Rows.Count, 1).End(xlUp).Row & lngLastRowAw
End Sub