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

da .. Makro bis Ende

da .. Makro bis Ende
Mike
Guten Morgen,
da die nachfolgende Geschichte leider noch nicht erledigt ist, erlaube ich mir,
sie noch einmal aufzugreiffen.
https://www.herber.de/forum/archiv/1120to1124/t1123239.htm#1123305
(Beispielsdatei ist dabei)
Fact ist: In einer Endlosliste wird - um unnötige Zeilen zu löschen - nach "Gebühren" gesucht
und verschiedene Zeilen mit einem x markiert, die später mittels Autofilter gelöscht werden.
Um das Makro nicht immer wieder starten zu müssen, wäre es schön, wenn es bis zum Ende
(letzte "Gebühren" durchlaufen würde).
Besten Dank für Eure Ideen.
Gruss
Mike

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: da .. Makro bis Ende
21.12.2009 11:54:57
fcs
Hallo Mike,
aus der ursprünglichen Frage blicke ich nicht durch, welche Zellen relativ zu den Fundzellen einen Eintrag "X" bekommen sollen.
ImPrinzip kannst du wie folgt eine Suchschleife aufbauen.
Gruß
Franz
Sub Markieren()
'Sucht nach Begriffen in SPalte 6 (F) und setzt eine oder mehrere Markierungen
On Error GoTo Fehler
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
If fncSuchen(vFind:="GEBÜHREN", SuchBereich:=ActiveSheet.Columns(6)) _
= False Then GoTo Fehler
If fncSuchen(vFind:="P R I M", SuchBereich:=ActiveSheet.Columns(6)) _
= False Then GoTo Fehler
If fncSuchen(vFind:="ÜBER- / UN", SuchBereich:=ActiveSheet.Columns(6)) _
= False Then GoTo Fehler
MsgBox "Markierung abgeschlossen", vbInformation + vbOKOnly, "Spezialsuche"
Fehler:
With Err
Select Case .Number
Case 0 'Null Probleme
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
Function fncSuchen(vFind As Variant, SuchBereich As Range, _
Optional vMarker As Variant = "X") As Boolean
Dim sAdresse1, Zelle As Range
On Error GoTo Fehler
fncSuchen = True
Set Zelle = SuchBereich.Find(what:=vFind, LookIn:=xlValues, lookat:=xlPart)
If Zelle Is Nothing Then
MsgBox "Suchbegriff """ & vFind & """ wurde nicht gefunden", _
vbInformation + vbOKOnly, "Spezialsuche"
Else
sAdresse1 = Zelle.Address '1. Fundstelle merken
Do
With Zelle
Select Case vFind
Case "GEBÜHREN"
'Zellen, die relativ zu Zellen mit "GEBÜHREN " markiert werden sollen
.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"
Case "P R I M"
'Zellen, die relativ zu Zellen mit "P R I M" markiert werden sollen
.Offset(-11, -2).Range("A1") = "x"
.Offset(1, 0).Range("A1") = "x"
.Offset(2, 0).Range("A1") = "x"
Case "ÜBER- / UN"
'Zellen, die relativ zu Zellen mit "ÜBER- / UN " markiert werden sollen
.Offset(13, -2).Range("A1") = "x"
.Offset(1, 0).Range("A1") = "x"
Case Else
MsgBox "Für Suchbegriff """ & vFind & _
""" wurde keine Case-Anweisung mit den zu markierenden Zellen erstellt", _
vbInformation + vbOKOnly, "Spezialsuche"
End Select
End With
'Neue Suche
Set Zelle = SuchBereich.FindNext(After:=Zelle)
Loop Until Zelle Is Nothing Or Zelle.Address = sAdresse1
End If
Fehler:
If Err.Number  0 Then
fncSuchen = False
MsgBox "Fehler-Nr.: " & Err.Number & vbLf & Err.Description, _
vbInformation, "Fehler in fcSuchen"
End If
End Function

Anzeige
wow .. Makro bis Ende
21.12.2009 13:06:11
Mike
Hey Frank,
wow, perfekt gelöst, besten Dank für Deine schnelle
Hilfe! Das ist der Hammer!!
Gruss
Mike

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige