Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1120to1124
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1120to1124
1120to1124
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro .. durchführen bis Ende

Makro .. durchführen bis Ende
Mike

Hallo zusammen,
mit nachfolgendem Makro werden dreiseitige (Endlos)Importe passend gemacht.
Da die Liste immer länger wird, sollte das Makro nicht nur einmal ausgeführt werden,
sondern bis zum Schluss durchlaufen (aktuell starte ich es immer wieder mit F4).
Wie kann ich dies entsprechend anpassen?
Danke und Gruss, Mike
Sub AA_Worten_Gebühr_Prim_modifiziert()
' Nach_Worten_suchen Makro
' Makro am 20.04.2005 von Mike aufgezeichnet
' 05.03.07 keine Selects mehr
Cells.Find(What:="GEBÜHREN &", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, -2).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
'ActiveCell.Offset(1, 0).Range("A1")="x"
'ActiveCell.Offset(1, 0).Range("A1").Select
Cells.Find(What:="P R I M", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(-11, -2).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(6, 0).Range("A1") = "x"
ActiveCell.Offset(2, 0).Range("A1") = "x"
'ActiveCell.Offset(1, 0).Range("A1")="x"
'ActiveCell.Offset(1, 0).Range("A1")="x"
'ActiveCell.Offset(1, 0).Range("A1").Select
Cells.Find(What:="ÜBER- / UN", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(13, -2).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
ActiveCell.Offset(1, 0).Range("A1") = "x"
'ActiveCell.Offset(1, 0).Range("A1")="x"
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub

Immer feste drauf klopfen / drucken... ;-)
11.12.2009 11:43:50
NoNet
Hallo Mike,
unabhängig jeglicher Codeoptimierung kannst Du die redundanten Codezeile rausschmeißen :
ActiveCell.Offset(1, 0).Range("A1") = "x"
Diese Zeile muss nach jedem Cells.Find(...) - Vorgang nur einmal ausgeführt werden und nicht 14 mal.
Excel VBA ist ja nicht so steinzeitlich, dass man "immer feste drauf klopfen" muss (wie beim Steine meiseln), damit der Text in der Zelle stehen bleibt (das war früher bei Schreibmaschinen mit eingetrocknetem Farbband jedoch hilfreich, Texte mehrmals zu überdrucken ;-).
Um andere Codeoptimierungen durchzuführen, müsste man wissen, WAS Du genau erreichen möchtest....
Gruß, NoNet
Anzeige
AW: Immer feste drauf klopfen / drucken... ;-)
11.12.2009 11:54:34
Chris
*lol* Genial NoNet
wird schon geklopfen ...
11.12.2009 12:04:17
Mike
Hey NoNet,
durch die Modifiktion der ursprünglichen Zeilen (hier ein Ausschnitt)
ActiveCell.Offset(1, -2).Range("A1").Select
ActiveCell.FormulaR1C1 = "x"
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.FormulaR1C1 = "x"
...
gabs nun ein AnOrtKloppen ... grrr!
Zum Verständnis: Mit den x werden die Zeilen ausgezeichnet,
die dann später gelöscht werden (Autofilter - x - löschen).
Oder anders ausgedrückt, aus den ursprünglich drei
ausführlichen Seiten wird eine längere kompakte Seite.
Daher wäre es schön, wenn die Prozedur nicht nur einmal
ausgeführt wird, sondern bis ans Ende der Datei. Die aktuell
drei CellFinds werde ich dann auch noch auf einen reduzieren,
da ab dem ersten Find die weiteren Positionen von "PRIM" sowie
"Über/Unter" klar sind.
Danke für die Hilfe. Gruss, Mike
Anzeige
hört mal wer hier hämmert ..
11.12.2009 12:52:11
Mike
... ;-) ... so, der Code modifiziert / entschlackt:
Sub AA_Worten_Gebühr_Prim_modifiziert()
' Nach_Worten_suchen Makro
' Makro am 20.04.2005 von Mike aufgezeichnet
' 05.03.07 keine Selects mehr
Cells.Find(What:="GEBÜHREN &", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, -2).Range("A1") = "x"
ActiveCell.Offset(2, -2).Range("A1") = "x"
ActiveCell.Offset(3, -2).Range("A1") = "x"
ActiveCell.Offset(4, -2).Range("A1") = "x"
ActiveCell.Offset(5, -2).Range("A1") = "x"
ActiveCell.Offset(6, -2).Range("A1") = "x"
ActiveCell.Offset(7, -2).Range("A1") = "x"
ActiveCell.Offset(8, -2).Range("A1") = "x"
ActiveCell.Offset(9, -2).Range("A1") = "x"
ActiveCell.Offset(10, -2).Range("A1") = "x"
ActiveCell.Offset(73, -2).Range("A1") = "x"
ActiveCell.Offset(74, -2).Range("A1") = "x"
ActiveCell.Offset(75, -2).Range("A1") = "x"
ActiveCell.Offset(76, -2).Range("A1") = "x"
ActiveCell.Offset(77, -2).Range("A1") = "x"
ActiveCell.Offset(78, -2).Range("A1") = "x"
ActiveCell.Offset(79, -2).Range("A1") = "x"
ActiveCell.Offset(80, -2).Range("A1") = "x"
ActiveCell.Offset(81, -2).Range("A1") = "x"
ActiveCell.Offset(87, -2).Range("A1") = "x"
ActiveCell.Offset(89, -2).Range("A1") = "x"
ActiveCell.Offset(129, -2).Range("A1") = "x"
ActiveCell.Offset(130, -2).Range("A1") = "x"
ActiveCell.Offset(131, -2).Range("A1") = "x"
ActiveCell.Offset(132, -2).Range("A1") = "x"
ActiveCell.Offset(133, -2).Range("A1") = "x"
ActiveCell.Offset(134, -2).Range("A1") = "x"
ActiveCell.Offset(135, -2).Range("A1") = "x"
ActiveCell.Offset(136, -2).Range("A1") = "x"
ActiveCell.Offset(137, -2).Range("A1") = "x"
ActiveCell.Offset(138, -2).Range("A1") = "x"
ActiveCell.Offset(139, -2).Range("A1") = "x"
ActiveCell.Offset(140, -2).Range("A1") = "x"
ActiveCell.Offset(141, -2).Range("A1") = "x"
ActiveCell.Offset(142, -2).Range("A1") = "x"
ActiveCell.Offset(143, -2).Range("A1") = "x"
End Sub

Jetzt wäre einfach noch die "Schlaufe" schön.
Danke für Eure Tipps.
Gruss
Mike
Anzeige
AW: hört mal wer hier hämmert ..
11.12.2009 13:22:51
Chris
Also nochmal im Klartest was möchtest du erreichen?
Zeile in der in einer bestimmten Spalte entweder "P R I M" oder "GEBÜHREN" steht soll gelöscht werden, oder?
find a way ..
11.12.2009 13:41:33
Mike
... to my idea .. ;-)
Hey Chris,
Das Suchen nach "Gebühren" ist der Ankerpunkt von
dem aus dann die überflüssigen Zeilen mit x markiert
werden.
Die x-Zeilen werden später mit dem Autofilter gelöscht.
Gruss
Mike
AW: find a way ..
11.12.2009 13:52:00
Chris
und warum kann man sie nicht gleich löschen?
Direkter Weg ..
11.12.2009 14:00:34
Mike
Hey Chris,
das könnte natürlich auch direkt geschehen. Mein ursprünglicher
Code war eine Rekorder-Aufzeichnung .. ;-)
Gruss
Mike
Anzeige
AW: Direkter Weg ..
11.12.2009 14:08:37
Chris
Da gibt es einen Genialen Code von Thomas Ramel:
Du brauchst dann in dein Makro nur noch eingeben
Sub löschen
DelRows Range("A:A"), "GEBÜHREN" 'löscht Gebühren weil die doof sind :-)
DelRows Range("A:A"), "P R I M" 'löscht Primzahlen weil die auch doof sind :-)
End Sub 
Public Sub DelRows(rngSpalte As Range, varValue As Variant)
'© Thomas Ramel / 24.01.2005
'Funktion zum Löschen ganzer Zeilen eines Tabellenblattes unter
'Berücksichtigung von Kriterien
'Bedingung: nicht mehr als 8125 unzusammenhängende Bereiche als Ergebnis
'Die Funktion kann nur von VBA aufgerufen werden *nicht* in einer Zelle
'Folgender Aufruf löscht alle Zeilen wenn in Spalte A '10' enthalten ist:
'DelRows Range("A:A"), 10
Application.ScreenUpdating = False
Application.Calculation = xlManual
If Application.WorksheetFunction.CountIf(rngSpalte, varValue) > 0 Then
If varValue = "" Then
rngSpalte.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Else
With rngSpalte
.Replace "", "##@@##", xlWhole
.Replace varValue, "", xlWhole
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Replace "##@@##", "", xlWhole
End With
End If
End If
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

Anzeige
Gebührend die Gebühren belassen..
11.12.2009 14:19:22
Mike
Hey Chris,
danke für den Code, aber es muss ja nicht "Gebühren" etc. gelöscht
werden, sondern Zeilen darunter .. :-/
Gruss
Mike
Sledgehammer ? - Nicht nötig...
11.12.2009 13:26:12
NoNet
Hallo Mike,
dazu benötigt man keinen "Vorschlaghammer" (sledgehammer) sondern es genügt ein kleines "Hämmerchen" - zumindest wenn die Abstände immer fest sind :
Sub AA_Worten_Gebühr_Prim_modifiziert3()
' Nach_Worten_suchen Makro
' Makro am 20.04.2005 von Mike aufgezeichnet
' 05.03.07 keine Selects mehr
With Cells.Find(What:="GEBÜHREN &", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
.Offset(1, -2).Resize(10).Value = "x"
.Offset(73, -2).Resize(9).Value = "x"
.Offset(86, -2).Value = "x"
.Offset(89, -2).Value = "x"
.Offset(129, -2).Resize(15).Value = "x"
End With
End Sub
Oder sind das die durch den Autofilter angezeigten Zeilen ? Dann wäre diese universellere Methode sinnvoller :
Sub AA_Worten_Gebühr_Prim_modifiziert4()
' Nach_Worten_suchen Makro
' Makro am 20.04.2005 von Mike aufgezeichnet
' 05.03.07 keine Selects mehr
Dim lngEZ As Long, lngLZ As Long, lngS As Long
With Cells.Find(What:="GEBÜHREN &", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
lngS = .Column - 2  'Spalte
lngEZ = .Row + 1    'Erste Zeile, lngLZ = Letzte Zeile
lngLZ = .CurrentRegion.SpecialCells(xlCellTypeVisible).Find("*", searchdirection:= _
xlPrevious).Row
Range(Cells(lngEZ, lngS), Cells(lngLZ, lngS)).Value = "x"
End With
End Sub
Gruß, NoNet
Anzeige
Hammer to fall ...
11.12.2009 13:38:57
Mike
Hey NoNet,
danke schon mal für die Modifikation, wird ja immer chicer. Der Hammer
fällt momentan jedoch erst einmal, sollte aber durchrauschen bis
Zeile 40'000.
Der Autofilter wird erst später angewandt zum Löschen der x.
Gruss
Mike
Step by Step ...
11.12.2009 13:48:09
Mike
Hey NoNet,
die Vermutung liegt wohl nicht falsch, dass alle "GEBÜHREN"
abgearbeitet werden, das Makro aber aktuell stur an den
gleichen Positionen hämmert .. :-/
Gruss
Mike
Sorry - dazu müsste ich Deine Tabelle kennen
11.12.2009 14:02:12
NoNet
Hey Mike,
kannst Du nicht mal deine Tabelle (oder eine modifizierte DEMO-Version) hochladen ?
Das würde mir/uns die Arbeit erheblich erleichtern, da niemand den Aufbau Deiner Tabelle kennt...
Gruß, NoNet
Anzeige
klar doch ..
11.12.2009 14:15:49
Mike
Hey NoNet,
klar doch, siehe im Anhang eine massiv verkürzte Version
der Importdaten -> https://www.herber.de/bbs/user/66525.xls
Danke und Gruss, Mike
<b>PS:</b> bin nachher leider weg, weitere Feedbacks kommen
morgen früh, danke für die Bemühungen.
ists .. - dazu müsste ich Deine Tabelle kennen
12.12.2009 10:17:03
Mike
Hey NoNet,
ists nun mit der Datei verständlicher? Danke fürs Feedback.
Gruss
Mike
@NoNet ... ists
14.12.2009 08:10:52
Mike
Hey NoNet,
ist nun mit der Beispieldatei verständlicher?
Danke und Gruss, Mike

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige