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

Funktionierendes Makro optimieren

Funktionierendes Makro optimieren
31.05.2014 12:05:13
Markus
Guten Morgen zusammen,
ich ein Programm geschrieben, was soweit das macht was ich will. Alledings lässt sich der Code der momentan aus 2 Makros besteht, sicherlich einfacher gestalten als meine Umsetzung.
Vielleicht kann sich das jemand ja mal anschauen und optimieren. Das eigentliche Problem ist, dass ich es nicht schaffe 2 ineinander laufende Schleifen zu programmieren.
Der Code wird über den Button gestartet.
Das Programm sucht nach einem bestimmten Kriteriendatensatz (hier Marke und Jahr) in einer Datenbank und listet alle gefundenen Eintrage des Kriterieumdatensatzes aus den jeweiligen Spalten aus der Zeile in dem der Kriteriumdatensatz steht. Sind alle Einträge des Kriteriumsdatensatzes gelistet, wird zum nächsten Kriteriumdatensatz gewechslet bis alle durchlaufen sind.
Das Programm läuft. Würde es nur gerne ein wenig einfach gestalten haben wollen.
Vielen Dank schon einmal.
https://www.herber.de/bbs/user/90928.xlsm
Gruß Markus

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Funktionierendes Makro optimieren
01.06.2014 10:14:54
Christian
hallo Markus,
hier ein Bsp. mit drei verschachtelten For-Schleifen
Option Explicit
Sub TestIt()
Dim strMarke As String
Dim lngJahr As Long
Dim i As Long, j As Long, k As Long
Dim lngLR As Long, lngRes As Long
lngRes = 9
With Worksheets("Übersicht")
'lösche Einträge in Spalte M ab Zeile 9
lngLR = .Cells(.Rows.Count, 13).End(xlUp).Row
.Cells(9, 13).Resize(lngLR - 8).Clear
'lösche Einträge in Spalte N ab Zeile 3
lngLR = .Cells(.Rows.Count, 14).End(xlUp).Row
.Cells(3, 14).Resize(lngLR - 2).Clear
'durchlaufe Spalte O ab Zeile 3:
For i = 3 To .Cells(.Rows.Count, 15).End(xlUp).Row
If .Cells(i, 15)  "" Then
'Suchkriterium Marke und Jahr
strMarke = .Cells(i, 15)
lngJahr = .Cells(i, 17)
'durchlaufe Spalte B ab Zeile 10:
For j = 10 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(j, 2) = strMarke And .Cells(j, 4) = lngJahr Then
'durchlaufe für diese Zeile die Spalten E bis I:
For k = 5 To 9
If .Cells(j, k)  "" Then
.Cells(lngRes, 13) = .Cells(j, k)
lngRes = lngRes + 1
End If
Next
End If
Next
'Eintrag in Spalte N:
.Cells(i, 14) = "x"
End If
Next
End With
End Sub
Gruß
Christian
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige