Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1604to1608
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

Simulation mit Schleife, Filter ohne Überschrift?

Simulation mit Schleife, Filter ohne Überschrift?
07.02.2018 04:20:08
Thomas
Hey Leute,
ich arbeite gerade an einer Simulation. Dafür muss ich viele Zufallszahlen generieren. Deswegen habe ich eine Schleife programmiert und einen Filter eingebaut.
Wenn ich also die Schleife starte, werden Zufallszahlen generiert und der Filter filtert entsprechend meinen Kriterien. Soweit so gut.
Nur wird bei der Filterung jedes mal die Überschrift auch übertragen und genau da liegt das Problem. Kann man das irgenwie rational lösen, da ich die Schleife sehr oft wiederholen muss.
Ich habe auch ein Beispiel hinzugefügt um mein Problem zu verdeutlichen. Im Tabellenblatt "Ergebnisse" auf den Button klicken und zB 10 mal ausführen,
dann erkennt ihr mein Problem.
https://www.herber.de/bbs/user/119611.xlsm
Hier der 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
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("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
End Sub

Besten Dank für die Hilfe

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Simulation mit Schleife, Filter ohne Überschrift?
07.02.2018 12:58:25
Thomas
ich konnte mittlerweile das Problem selber lösen.
Hier meine Änderung:
'lngLastRowDi = Sheets("Ergebnisse").Range("A" & Rows.Count).End(xlUp).Row + 1
'CopyToRange:=Sheets("Ergebnisse").Range("A" & lngLastRowEg + 1), _
Unique:=False
vollständiger 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
beste grüße
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige