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

verschachtelte Schleife???

verschachtelte Schleife?
21.06.2018 16:22:07
EasyD
und wieder Hallo, ich komme derzeit wieder öfters vorbei
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

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

Betreff
Datum
Anwender
Anzeige
AW: verschachtelte Schleife?
21.06.2018 16:58:21
mmat
Hallo,
ich kann deine Bedenken bezüglich deiner Selbsteinschätzung nachvollziehen.
Ich vermute mal, dass du in Ex eine Liste aller Treffer haben möchtest, wobei das aktuelle Arbeitsblatt (Spalte A) nach Werten durchsucht wird, die in der Liste der Suchbegriffe (Spalte W des Sheets Auswertungen) stehen.
Ist das so richtig ?
AW: verschachtelte Schleife?
22.06.2018 08:02:19
EasyD
In Sachen Selbsteinschätzung lerne ich noch dazu ;)
Hast es so korrekt nachvollzogen, Rudi hatte die passende (und vor allem ggü meinem Versuch wesentlich einfachere Lösung).
AW: verschachtelte Schleife
22.06.2018 11:00:20
mmat
jo, Rudis Code scheint zu passen. Wenn es noch was gibt, dann frag einfach (am besten mit einer neuen Anfrage).
Anzeige
AW: verschachtelte Schleife?
21.06.2018 17:04:38
Rudi
Hallo,
wenn die Liste sortiert ist, kann man alles auf einmal kopieren anstatt Zeilenweise.
Probier das mal:
Public Sub Start()
'Für jede aufgeführte Nummer auf dem Blatt Auswertung wird das Makro ausgeführt
Dim i As Long, j As Long
Dim letzte As Long
Dim vntMatch, vntRow, lngCount As Long
Dim rngMatch As Range
Set rngMatch = Sheets("auswertung").Range("A101:A437")
letzte = Sheets("Auswertung").Range("W150").End(xlUp).Row
For i = 99 To letzte
'Zuerst auf dem Blatt Ex den letzten Kopiervorgang löschen (ohne Überschriften)
Sheets("Ex").Range("A2:L1048576").ClearContents
'Nummer in A2 schreiben -> zur Bereitstellung des Dateinahmens für die csv
vntMatch = Sheets("Auswertung").Cells(i, 23).Value
Sheets("Auswertung").Range("A2") = vntMatch
lngCount = WorksheetFunction.CountIf(rngMatch, vntMatch)  'Anzahl Einträge
If lngCount > 0 Then
vntRow = Application.Match(vntMatch, rngMatch, 0) 'erste Zeile
rngMatch.Cells(vntRow, 1).Resize(lngCount, 12).Copy
Sheets("Ex").Cells(2, 1).PasteSpecial xlPasteValues
'Nullbeträge löschen
Call DelZero
'Exportieren
Call ExportCSV
End If
Next i
Application.CutCopyMode = False
End Sub

Gruß
Rudi
Anzeige
AW: verschachtelte Schleife?
22.06.2018 08:00:24
EasyD
Hallo Rudi
prima
natürlich ist es sinnvoller, gleich den ganzen Bereich zu kopieren, statt zeilenweise.
läuft sicherlich so auch um einiges fixer durch. Ich hatte nur leider keinerlei Ansatz den Bereich zu definieren den ich kopieren möchte (da auch variabel von der Länge her). Die Funktion WorksheetFunction.CountIf kannte ich bis dato noch nicht, wird mir sicherlich auch an anderer Stelle nochmal helfen.
Jedenfalls klappt es reibungslos, vielen Dank!
Lediglich der Export macht im Moment noch aus irgendeinem Grund gar nichts, da muss ich noch auf Ursachenforschung gehen.
Grüße
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige