Anzeige
Archiv - Navigation
1256to1260
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

wie besser? viele unnötige(?) For/Next-Schleifen

wie besser? viele unnötige(?) For/Next-Schleifen
Ronald
Liebe Excel-Freunde,
ich habe hier (ganz schrecklichen?) Anfängercode.
Er läuft (schon mal schön), aber aufgrund der ganzen Schleifen auch recht langsam.
Hat jemand vielleicht Lust mir zu sagen bzw. die Richtung zu nennen, wie ich das besser/schöner/schneller lesen kann?
Ich hatte es anfangs mit mehr If und Then Verzweigungen versucht, aber da hatte ich mich wohl verzettelt. Brach immer irgendwo mit Fehlermeldung ab oder tat einfach nicht das, was ich wollte (böser Code, der ;-).
In einzelnen Schleifen nacheinander läuft es dann jetzt....
Aber diese ganzen For/Next-Schleifen, nacheinander...das muss doch anders gehen. Pro Zeile alles gleich auf einmal abarbeiten....
Ich versuche vom Blatt "septdat3.rpt" die Daten entsprechend Zeile für Zeile abzulaufen, umzubenennen, auf ein anderes Blatt zu kopieren und von dort aus auf wieder andere Blätter zu verteilen.
Ich denke, es würde viel Zeit einsparen, wenn ich die Schleifen richtig programmieren würde und nicht jedes mal alles von vorne durchlaufen wird in Einzelschritten, oder?
Im Falle der Daten dieses Monats sind es dann doch immerhin 18.000 Zeilen, die immer wieder von vorne durchlaufen werden....
Ich habe etwas Code zwischendurch gelöscht, da er unwichtig für meine Frage ist (Fehlermeldungen etc). Wie gesagt. Es funktioniert eigentlich ja auch...
Und: ja, hab grad gesehen, dass noch nicht alle Variablen sauber deklariert wurden....
Falls jemand Lust hat zu antworten: schon einmal ein großes Dankeschön im Voraus!!
Ronald
Sub Kopieren()
Dim colDate As Byte, colLength As Byte, colPhone As Byte, colStudyID As Byte
Dim tbName As String, tbNameNEU As String, tbTelefon As String
Dim A As Object
Dim LoLetzte1 As Long, LoLetzte2 As Long, LoLetzte3 As Long
Dim LoJ As Long, LoH As Long, LoI As Long, LoK As Long, LoL As Long
Dim strSuch1, strSuch2
Dim TextProjekt, ProjektNr, Leerzeichen
Dim loMonat As String, Mydate As Date
Dim RowProjekt As Long, NrProjekt As Long
Dim RowAULL As Long, RowAUMOB As Long, RowDELL As Long, RowDEMOB As Long
Dim CallLength As Integer
Dim tbProjekt As String, tbProjektkosten As String
Dim LastRow As Long, PathXls, FileNameXls, loMonatXls As String
tbName = "septdat3.rpt"
tbNameNEU = "septdat3 (bearbeitet)"
tbTelefon = "Telefonkosten"
PathXls = ThisWorkbook.Path
loMonatXls = Format(Now, "yyyy")
Application.ScreenUpdating = False
ThisWorkbook.Worksheets(tbName).Select
LoLetzte1 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
ThisWorkbook.Worksheets(tbName).Cells(1, colStudyID + 1).Value = "ProjektNummer"
For LoH = 2 To LoLetzte1
If ThisWorkbook.Worksheets(tbName).Cells(LoH, 1).Value = "Date Count:" Then
ThisWorkbook.Worksheets(tbName).Cells(LoH, 1).EntireRow.Delete
End If
Next LoH
For LoI = 2 To LoLetzte1
If ThisWorkbook.Worksheets(tbName).Cells(LoI, 2).Value = "" And ThisWorkbook.Worksheets( _
tbName).Cells(LoI, 3).Value = "" Then
ThisWorkbook.Worksheets(tbName).Cells(LoI, 1).EntireRow.Delete
End If
Next LoI
For LoJ = 1 To LoLetzte1
If ThisWorkbook.Worksheets(tbName).Cells(LoJ, 1)  "" Then
If IsDate(ThisWorkbook.Worksheets(tbName).Cells(LoJ, 1)) Then
ThisWorkbook.Worksheets(tbName).Cells(LoJ, 1).NumberFormat = "m/d/yyyy"
ThisWorkbook.Worksheets(tbName).Cells(LoJ, 1).Font.Bold = False
strSuch1 = ThisWorkbook.Worksheets(tbName).Cells(LoJ, 1).Value
Mydate = strSuch1
loMonat = Format(Mydate, "mmmm")
End If
End If
If ThisWorkbook.Worksheets(tbName).Cells(LoJ, 1).Value = "" Then
If ThisWorkbook.Worksheets(tbName).Cells(LoJ, 2).NumberFormat = "h:mm:ss AM/PM" Then
ThisWorkbook.Worksheets(tbName).Cells(LoJ, 1).Value = strSuch1
End If
End If
Next LoJ
LoLetzte2 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
On Error Resume Next
For LoK = 1 To LoLetzte2
TextProjekt = ThisWorkbook.Worksheets(tbName).Cells(LoK, colStudyID).Value
Leerzeichen = InStr(1, Cells(LoK, colStudyID), " ")
ProjektNr = Left(TextProjekt, Leerzeichen - 1)
ThisWorkbook.Worksheets(tbName).Cells(LoK, colStudyID).Value = ProjektNr
Next LoK
ThisWorkbook.Worksheets(tbName).Range(Columns(colDate), Columns(colDate)).Select
Selection.Copy
ThisWorkbook.Worksheets(tbNameNEU).Select
Columns("A:A").Select
ActiveSheet.Paste
ThisWorkbook.Worksheets(tbName).Select
Range(Columns(colLength), Columns(colLength)).Select
Selection.Copy
ThisWorkbook.Worksheets(tbNameNEU).Select
Columns("B:B").Select
ActiveSheet.Paste
ThisWorkbook.Worksheets(tbName).Select
Range(Columns(colPhone), Columns(colPhone)).Select
Selection.Copy
ThisWorkbook.Worksheets(tbNameNEU).Select
Columns("C:C").Select
ActiveSheet.Paste
ThisWorkbook.Worksheets(tbName).Select
Range(Columns(colStudyID), Columns(colStudyID)).Select
Selection.Copy
ThisWorkbook.Worksheets(tbNameNEU).Select
Columns("D:D").Select
ActiveSheet.Paste
ThisWorkbook.Worksheets(tbNameNEU).Select
LoLetzte3 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For LoL = 2 To LoLetzte3
strSuch2 = ThisWorkbook.Worksheets(tbNameNEU).Cells(LoL, 4).Value
With ThisWorkbook.Worksheets("Projektnummern").Range("A1:A100")
Set A = .Find(strSuch2, LookIn:=xlValues)
If Not A Is Nothing Then
RowProjekt = A.Row
NrProjekt = ThisWorkbook.Worksheets("Projektnummern").Cells(RowProjekt, 2).Value
tbProjekt = ThisWorkbook.Worksheets("Projektnummern").Cells(RowProjekt, 3).Value
End If
End With
ThisWorkbook.Worksheets(tbNameNEU).Select
ThisWorkbook.Worksheets(tbNameNEU).Cells(LoL, 5).Value = NrProjekt
ThisWorkbook.Worksheets(tbNameNEU).Cells(LoL, 8).Value = loMonat
ThisWorkbook.Worksheets(tbNameNEU).Cells(LoL, 9).Value = tbProjekt
Next LoL
For LoL = 2 To LoLetzte3
ThisWorkbook.Worksheets(tbNameNEU).Select
TelNummer = ThisWorkbook.Worksheets(tbNameNEU).Cells(LoL, 3).Value
Call TelNummern
ThisWorkbook.Worksheets(tbNameNEU).Cells(LoL, 6).Value = TypeVal
Call TelKosten
CallLength = ThisWorkbook.Worksheets(tbNameNEU).Cells(LoL, 2).Value
ThisWorkbook.Worksheets(tbNameNEU).Cells(LoL, 7).Value = CallLength * TelCosts
TypeVal = ""
TelNummer = ""
Next LoL
ThisWorkbook.Worksheets(tbNameNEU).Select
LoLetzte3 = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For LoL = 2 To LoLetzte3
ThisWorkbook.Worksheets(tbNameNEU).Select
tbProjektkosten = ThisWorkbook.Worksheets(tbNameNEU).Cells(LoL, 9).Value
ThisWorkbook.Worksheets(tbNameNEU).Range(Cells(LoL, 1), Cells(LoL, 8)).Select
Selection.Copy
ThisWorkbook.Worksheets(tbProjektkosten).Select
Cells(65000, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next LoL
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
PathXls & "\" & "Dialerkosten_" & loMonat & "-" & loMonatXls & ".xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
Sheets("septdat3.rpt").Select
ActiveWindow.SelectedSheets.Delete
Sheets("septdat3 (bearbeitet)").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Info").Select
ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Call ArrayBefuellen
MsgBox "Ich habe fertig!!"
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: wie besser? viele unnötige(?) For/Next-Schleifen
14.04.2012 14:23:11
Hajo_Zi
Hallo Rnald,
ich habe es mal getestet. Bei mir wird das Makro nicht mal gestartet. Da Variablen nicht definiert und Prozeduren fehlen.

AW: wie besser? viele unnötige(?) For/Next-Schleifen
14.04.2012 17:31:45
fcs
Hallo Ronald,
hallo dein VBA-Makro kann/muss in folgenden Bereichen angepasst werden:
1. Schleifenzähler in For-Next-Schleifen
Wenn innerhalb einer Schleifen Zeilen gelöscht werden, dann muss der Schleifenzähler beim höchsten Wert beginnen und dann rückwärts zählen.
Hier hast du scheinbar Glück gehabt, dass es trotzdem funktioniert hat bzw. ist einer der Gründe, warum du mehrere Schleifen benötigst, damit es korrekt läuft.
Excel verschiebt ja beim Löschen von Zeilen die restlichen Zeilen jeweils nach oben, was dann ggf. Probleme kreiert.
2. Anzahl der Schleifen
Hier ist wenig bis kein Handlungsbedarf.
Für das bearbeiten von If-Prüfungen benötigt Excel relativ viel Zeit.
So können mehrere Schleifen mit jeweils einer If-Prüfung schneller sein als eine Schleife mit mehreren oder verschachtelten If-Prüfungen.
3. xxx.Select gefolgt von Selection.yyy
Diese machen das Makro langsam.
Durch Deklaration von entsprechenden Worksheet-Objektvariablen kann man hier immer die Objekte direkt ansprechen bei den Methoden und Funktionen.
Das Makro benötigt dann bei vielen Daten-Zeilen nur noch etwa die halbe Zeit.
4. Variablen für Schleifenzähler
Hier muss du nicht für jede Schleife eine andere Variable verwenden. Da die Schleifen nicht geschachtelt sind kommst du mit einer Variablen aus. Gleiches gilt für den Endwert (ZeilenZahl) der Schleifen.
5. On Error Resume Next
Diese Anweisung sollte sehr sparsam (besser nicht) eingesetzt werden.
Besser ist es geeignete Prüfungen einzubauen, wenn Fehler den Makro-Ablauf unterbrechen können.
Beipiel:
     Leerzeichen = InStr(1, Cells(LoK, colStudyID), " ")
If Leerzeichen >0 then ProjektNr = Left(TextProjekt, Leerzeichen - 1)

vermeidet den Fehler, wenn im Zelltext kein Leerzeichen gefunden wurde.
Gruß
Franz
In der hochgeladenen Datei hab ich deinen Code mal in eine optimierte Fassung umgebaut.
https://www.herber.de/bbs/user/79801.txt
Anzeige
AW: wie besser? viele unnötige(?) For/Next-Schleifen
16.04.2012 13:49:57
Ronald
Hallo Hajo,
trotzdem danke für die Mühe es zu testen. Richtig, es waren nur Auszüge. Ich wollte gar nicht, dass jemand alles ganz neu für mich schreibt...würde ich gar nicht erwarten, auch wenn einige hier tatsächlich so hilfsbereit sind.
Ich hatte mir gewünscht eine Antwort wie die von Franz zu erhalten...
Hallo Franz,
vielen Dank für deine Mühe und die Freundlichkeit einen Teil deines Wissens mit mir zu teilen.
Super-Erklärungen, sehr verständlich für mich und ich bin wieder ein ganzes Stück schlauer bezüglich VBA.
Gerade über die select/selection-Geschichte bin ich jetzt in den letzten Tagen schon mehrfach gestolpert.
Habe mir den Code eben angeschaut und sehe, was du meinst und gemacht hast.
Das führe ich mir jetzt die Tage noch in Ruhe zu Gemüte und werde meinen Code entsprechend anpassen.
Vielen Dank noch einmal an euch!!!!
Echt toll.....
Ronald
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige