verschachtelte Schleife?
21.06.2018 16:22:07
EasyD
jetzt habe ich gerade überlegt, ob ich wirklich "Excel gut - VBA gut" angeben sollte...
Ich habe versucht eine Schleife in eine Schleife einzubauen, vielleicht ist das auch gar nicht der richtige Ausatz.
Ausgangslage:
Auf dem Blatt "Auswertung" stehen ab Zeile 101 bis Zeile 437 in Spalte A bis L Werte.
In Spalte A unterschiedliche Suchbegriffe. Mehrfachnennungen sind möglich, aber sortiert untereinander. Es kommen also immer erst alle Zeilen mit dem ersten Suchbegriff in Spalte A, dann die mit dem zweiten usw.
Ebenfalls auf "Auswertung" von W99:W122 steht eine Liste dieser Suchbegriffe.
Ich will:
Als erstes das Blatt "Ex" leer machen.
Dann für jeden der Suchbegriffe aus Spalte W die Spalte A durchsuchen und wenn gefunden auf das Blatt "Ex" kopieren.
Anschließend sollen mittels DelZero Zeilen auf "Ex" wieder gelöscht werden wenn in Spalte 7 0,00 Beträge enthalten sind (das läuft m.E. - ist ein schon getesteter Code).
Danach soll Exportiert werden mit ExportCSV (sollte m.E. ebenfalls laufen).
Anschliessend startet der nächste Durchlauf damit, dass "Ex" wieder leer gemacht wird.
Das Ziel:
Ich will genauso viele csv-Dateien exportieren, wie ich Suchbegriffe habe.
Meine 3 Codes:
Public Sub Start()
'Für jede aufgeführte Nummer auf dem Blatt Auswertung wird das Makro ausgeführt
Dim i As Long
Dim letzte As Long
letzte = Sheets("Auswertung").Range("W150").Cells.End(xlUp).Row
For i = 99 To letzte
'Nummer in A2 schreiben -> zur Bereitstellung des Dateinahmens für die csv
Sheets("Auswertung").Range("A2") = Sheets("Auswertung").Cells(i, 23).Value
For j = 101 To 437
'Zeilen auf Ex kopieren
'Zuerst auf dem Blatt Ex den letzten Kopiervorgang löschen (ohne Überschriften)
Sheets("Ex").Range("A2:L1048576").ClearContents
'kopieren
If Cells(i, 1) = Sheets("Auswertung").Cells(i, 23).Value Then
Range(Cells(i, 1), Cells(i, 12)).Copy
Sheets("Ex").Range("A1048576").Cells.End(xlUp).Row.PasteSpecial xlPasteValues
End If
Next j
Next i
Application.CutCopyMode = False
'Nullbeträge löschen
Call DelZero
'Exportieren
Call ExportCSV
End Sub
Public Sub DelZero()
Dim x As Long
'0,00-Beträge = Ganze Zeile löschen
'### beim Löschen von ganzen Zeilen immer rückwärts ###
For x = 20 To 2 Step -1 'löschen Zeile 20 bis Zeile 2 (in Zeile 1 werden ja keine Formeln rein _
_
kopiert) ###
If Sheets("Ex").Cells(x, 7).Value = 0 Then
Sheets("Ex").Cells(x, 7).EntireRow.Delete
End If
Next x
End Sub
Public Sub ExportCSV()
Dim Bereich As Range, Zeile As Range, Zelle As Range
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String
Dim blnAnfuehrungszeichen As Boolean
With Sheets("Ex").PageSetup
.LeftHeader = Sheets("Auswertung").Range("A2") 'Kopfzeile ausfüllen mit der Nummer
strMappenpfad = ActiveWorkbook.FullName
strDateiname = Worksheets("Auswertung").Range("A2") & "_" & "blubberblubber" & "_" & _
Format(Worksheets( _
"Auswertung").Range("C7"), "mm.yyyy") & ".csv"
strTrennzeichen = ";"
blnAnfuehrungszeichen = False
Set Bereich = Sheets("Ex").UsedRange
Open strDateiname For Output As #1
For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If blnAnfuehrungszeichen = True Then
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next
End With
Close #1
Set Bereich = Nothing
End Sub
Kann diese Verschachtelung so überhaupt funktionieren?
Grüße