Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1536to1540
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

If.. like... or.. then...

If.. like... or.. then...
19.01.2017 16:46:40
John
Hallo zusammen,
habe ein kleines Problem..
Ich möchte ein Konto mit ca. 6.000 Buchungen auf bestimmte Begriffe überprüfen lassen und wie folgt farblich kennzeichnen:
grün = Buchung in Ordnung
orange = keine Zuordnung möglich
rot = falsche Buchung
Am Schluss sollen nur noch die roten und die orangenen Zeilen stehen bleiben!
Das unten aufgeführte Makro hängt sich jedoch nach ca. 1.900 geprüften Zeilen immer auf...
Bzw. es stoppt kurz. und markiert dann nicht mehr grün weiter!
Siehe fett markierte Stelle!
Also er markiert bis dahin alles schön fleißig mit grün, wenn einer der Begriffe im Text vorkommt (z.B. Traini, Schul, Reise, Verpfl, ...)
Leider kann ich aus Datenschutz keine Beispieldateien uploaden.
Hat vielleicht trotzdem jmd. eine Idee, was ich falsch mache..?
Vielen Dank!
BG John
Sub Kontrolle()
'J.K. 16.01.2017
Dim n As Long
Dim o As Long
Dim p As Long
Dim k As Long
'Application.ScreenUpdating = False
k = 8
p = 8
'Vorbearbeitung des Datenabzuges
Workbooks("Prüfungs-Tool Konto 1775115000.xls").Sheets("Datenabzug hier einfügen").Activate
Range("A2:A3").Select
Selection.Cut
Range("D2").Select
ActiveSheet.Paste
Columns("A:C").Select
Selection.Delete Shift:=xlToLeft
Range("D2:E3").Select
Selection.Cut
Range("B2").Select
ActiveSheet.Paste
Columns("D:E").Select
Selection.Delete Shift:=xlToLeft
Range("N:N,Q:Q,R:R,S:S").Select
Selection.Delete Shift:=xlToLeft
Columns("A:P").Select
Columns("A:P").EntireColumn.AutoFit
'Alle Zeilen orange färben
Dim loLetzte1 As Long
loLetzte1 = IIf(IsEmpty(Cells(Rows.Count, 1)), _
Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
Range("A8:O" & loLetzte1).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
'Bestimmte Zeichenketten grün markieren
Dim loLetzte11 As Long
loLetzte11 = IIf(IsEmpty(Cells(Rows.Count, 1)), _
Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
loLetzte12 = loLetzte11 - 6
Range("O" & k).Select
Do While loLetzte11 > 1
'Begriffe einfügen
If (ActiveCell.Value Like "*Traini*" Or _
ActiveCell.Value Like "*Schul" Or _
ActiveCell.Value Like "*Weiterbild*" Or _
ActiveCell.Value Like "*Reise*" Or _
ActiveCell.Value Like "*Verpfl*" Or _
ActiveCell.Value Like "*Bus*" Or _
ActiveCell.Value Like "*Ausbil*" Or _
ActiveCell.Value Like "*Betreu*" Or _
ActiveCell.Value Like "*Meet*" Or _
ActiveCell.Value Like "*Workshop*" Or _
ActiveCell.Value Like "*Tag*" Or _
ActiveCell.Value Like "*Semi*" Or _
ActiveCell.Value Like "*Lehrgang*" Or _
ActiveCell.Value Like "*Geb*" Or _
ActiveCell.Value Like "*Tagung*" Or _
ActiveCell.Value Like "*ün*" Or _
ActiveCell.Value Like "*Honorar*" Or _
ActiveCell.Value Like "*Sicherheit*" Or _
ActiveCell.Value Like "*Kick*" Or _
ActiveCell.Value Like "*Bosch*" Or _
ActiveCell.Value Like "*Studien*" Or _
ActiveCell.Value Like "*Prüfung*" Or _
ActiveCell.Value Like "*Team*" Or _
ActiveCell.Value Like "*Miete*" Or _
ActiveCell.Value Like "*Übern*") Then
Range("A" & k, ("O" & k)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("O" & k).Select
ActiveCell.Offset(1, 0).Select
k = k + 1
Else
ActiveCell.Offset(1, 0).Select
k = k + 1
End If
loLetzte11 = loLetzte11 - 1
Loop

'Bestimmte Zeichenketten rot markieren
Dim loLetzte7 As Long
loLetzte7 = IIf(IsEmpty(Cells(Rows.Count, 1)), _
Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
loLetzte8 = loLetzte7 - 6
Range("O" & p).Select
Do While loLetzte8 > 1
If (ActiveCell.Value Like "*Betriebsveranst*" Or _
ActiveCell.Value Like "*feier*" Or _
ActiveCell.Value Like "*fest*") Then
Range("A" & p, ("O" & p)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("O" & p).Select
ActiveCell.Offset(1, 0).Select
p = p + 1
Else
ActiveCell.Offset(1, 0).Select
p = p + 1
End If
loLetzte8 = loLetzte8 - 1
Loop
'Zeilen nach Farben sortieren und dann grünen Zeilen ausblenden
Dim r As Range
For Each r In ActiveSheet.UsedRange.Rows
If r.Interior.Color = 5296274 Then r.EntireRow.Hidden = True
Next r
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: If.. like... or.. then...
19.01.2017 16:49:06
John
Dim n As Long
Dim o As Long
am anfang... einfach wegdenken. :) die hab ich vergessen zu löschen
Beispieldatei sensible Daten ändern
19.01.2017 17:08:14
Tino
Hallo,
kannst Du ein Beispiel nicht original hochladen, sensible Daten kannst Du ja abändern.
Kurz beschreiben wo/was gesucht werden soll und was wann damit gemacht werden soll.
Gruß Tino
AW: Beispieldatei sensible Daten ändern
20.01.2017 12:58:11
Tino
Hallo,
kannst ja mal testen.
https://www.herber.de/bbs/user/110748.zip
Gruß Tino
Anzeige
AW: If.. like... or.. then...
20.01.2017 09:42:50
John
OKAY KANN GESCHLOSSEN WERDEN!!!
Danke!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige