Verinfachung

letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row For x = letztezeile To 2 Step -1 If Range("C" & x).Value > Range("G" & x).Value And Range("D" & x).Value Range("G" & x).Value And Range("D" & x).Value > Range("G" & x) _ .Value And IsNumeric(Range("G" & x).Value) And (Range("C" & x).Value) / 2 = Range("G" & x).Value Then Range("G" & x).Interior.ColorIndex = 0 End If If Range("C" & x).Value > Range("H" & x).Value And Range("D" & x).Value Range("G" & x).Value And Range("D" & x).Value > Range("H" & x) _ .Value And IsNumeric(Range("H" & x).Value) And (Range("C" & x).Value) / 2 = Range("H" & x).Value Then Range("H" & x).Interior.ColorIndex = 0 End If Next

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Verinfachung

27.01.2016 11:06:20

ChrisL

Tippfehler

27.01.2016 13:06:09

Michael

Ups... Danke o.T.

27.01.2016 13:29:39

ChrisL

AW: Verinfachung

27.01.2016 11:09:18

ChrisL

Vorschlag

27.01.2016 13:55:35

Michael

AW: Vorschlag

29.01.2016 07:21:15

Larissa

AW: Vorschlag

29.01.2016 12:06:38

Michael

AW: Vorschlag

29.01.2016 12:25:18

Larissa

na fein, danke für die Rückmeldung owT

29.01.2016 13:02:30

Michael

Sub t() Dim letztezeile As Long Dim x As Long, y As Byte Dim rng As Range letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row For x = letztezeile To 2 Step -1 For y = 7 To 25 ' Buchstabe 7 = G bis Buchstabe 25 = O Set rng = Cells(x, 7) If Range("C" & x).Value > rng.Value And Range("D" & x).Value rng.Value And Range("D" & x).Value > rng.Value And _ IsNumeric(rng.Value) And (Range("C" & x).Value) / 2 = rng.Value Then rng.Interior.ColorIndex = 0 End If Next y Next x End Sub

Hi zusammen,
hier mal zum Testen:

Option Explicit
Sub test()
Dim letztezeile As Long, z As Long, s As Long
Dim rC As Variant, rD As Variant, rG As Variant
Dim spalten As Variant
spalten = Array("G", "H", "I", "J", "K", "M", "N", "O")
' *****     Zitat:           G, H, I,  J,  K,  M, N, O etc.
' also z.B. ohne "L"?!
letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For z = letztezeile To 2 Step -1
rC = Range("C" & z).Value
rD = Range("D" & z).Value
For s = LBound(spalten) To UBound(spalten)
rG = Range(spalten(s) & z).Value
If rC > rG And rD  rG And rD > rG And _
IsNumeric(rG) And rC / 2 = rG Then
Range(spalten(s) & z).Interior.ColorIndex = 0
End If
Next s
Next z
End Sub

Ich lade den Wert jeder Zelle nur *einmal*, so daß a) Vergleiche ohne andauernde Zugriffe aufs Tabellenblatt erfolgen (das ist deutlich schneller) und b) der Code "kleiner" und (zumindest für meinen Geschmack) damit übersichtlicher ist.
Kernstück ist das Array "Spalten", in dem alle benötigten Spaltenbuchstaben mit "" eingetragen und dann vom Makro Spalte für Spalte abgearbeitet werden.
Das Makro ist nur "halb" optimiert; richtig gut wäre es, den kompletten Bereich als Array einzulesen, dann flutscht das auch bei ein paar 1000 Zeilen - falls überhaupt nötig.
Außerdem: die Logik selbst kann man sicher verbessern. Eine Umstellung der If-Verschachtelung würde ich aber nur angehen wollen, wenn ich Beispieldaten kenne.
Kritisch finde ich auf alle Fälle, *zuerst* Vergleiche mit kleiner/größer vorzunehmen und *dann erst* zu prüfen, ob der Wert in G überhaupt numerisch ist: letzteres gehört sich in die allererste If-Abfrage.
Schöne Grüße,
Michael

Option Explicit Sub test() Dim letztezeile As Long, z As Long, s As Long Dim rC As Variant, rD As Variant, rG As Variant Dim spalten As Variant spalten = Array("D", "G", "H", "J", "K", "M", "N", "O", , "P", "S", "T", "U", "V", "W", "X", "Z" _ ) ' ***** Zitat: G, H, I, J, K, M, N, O etc. ' also z.B. ohne "L"?! letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row For z = letztezeile To 2 Step -1 rC = Range("C" & z).Value rD = Range("D" & z).Value For s = LBound(spalten) To UBound(spalten) rG = Range(spalten(s) & z).Value If IsNumeric(rG) Then If rC > rG And rD rG And rD > rG And _ IsNumeric(rG) And rC / 2 = rG Then Range(spalten(s) & z).Interior.ColorIndex = 0 End If End If Next s Next z End Sub

Hi Larissa,
zwei Sachen fallen mir auf den ersten Blick auf:
a) bei
spalten = Array("D", "G" ....
ist "D" enthalten, d.h. Du überprüfst die Spalte D mit sich selber - ist das erwünscht?!
b) hier: "O", , "P" ist ein Komma zu viel: ich hatte es erst draußen und dann wieder reingemacht: der Fehler liegt genau da dran.
Ich interpretiere das mal so: durch das zusätzlich Komma wird ein "leeres" Element in das Array spalten eingefügt, und wenn in der Zeile

    rG = Range(spalten(s) & z).Value

(hier bleibt VBA bei mir stehen) versucht wird, dem Range ein "Nichts" als Spaltenbuchstaben zuzuweisen, spuckt es.
Zur Logik: Du hast ja das isnumeric ganz an den Anfang gesetzt; allerdings fragst Du es erneut im mittleren elseif-Zweig ab - das ist doppelt gemoppelt und kann rausgelöscht werden.
Überprüfe bitte kurz den 1. und den 3. Fall, da wird rD und rG verglichen; rD=rG fehlt.
Analog bei 1. und 2., da fehlt rC=rG.
Ich hab Dir auf dem 2. Blatt mal so was wie eine Wahrheitsmatrix skizziert; so ähnlich kannst Du mehrere verschachtelte Ifs auf Papier notieren und Dir einen Überblick verschaffen, was passiert.
Die Datei: https://www.herber.de/bbs/user/103141.xls
Schöne Grüße,
Michael

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread