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

Zahlenreihen prüfen

Zahlenreihen prüfen
13.01.2013 21:33:31
Maximilian
Hallo,
gibt es eine einfache Möglichkeit, per VBA zu prüfen, ob sich in einer Zahlenreihe zweimal ein Wert hintereinander verschlechtert hat?
Die Reihen sehen so aus:
Userbild
Im markierten Feld hat sich der Wert zwei mal hintereinander verschlechtert. Wenn das der Fall ist, möchte ich, die drei Felder rot markiert werden.
Problem dabei sind für mich die leeren Zellen. Wenn eine Zelle leer ist, soll der nächste verfügbare Vergangenheitswert vergleichen werden.
Man könnte das jetzt natürlich über komplizierte Schleifen machen, aber vielleicht weiß jemand eine einfache Lösung.
Danke

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Zahlenreihe prüfen
14.01.2013 07:23:14
Erich
Hi,
probier mal

Option Explicit
Sub Schlechter2()
Dim rngB As Range, arQ, arT(), cc As Long, nn As Long
Set rngB = Range("E3:W3")     ' hier Bereich (in einer Zeile)
arQ = rngB
ReDim arT(1 To UBound(arQ, 2), 1 To 2)
For cc = 1 To UBound(arQ, 2)
If Not IsEmpty(arQ(1, cc)) Then
nn = nn + 1
arT(nn, 1) = cc + rngB.Column - 1
arT(nn, 2) = arQ(1, cc)
End If
Next cc
rngB.Interior.ColorIndex = xlColorIndexNone
For cc = 1 To nn - 2
If arT(cc, 2) > arT(cc + 1, 2) And _
arT(cc + 1, 2) > arT(cc + 2, 2) Then
Range(Cells(rngB.Row, arT(cc, 1)), _
Cells(rngB.Row, arT(cc + 2, 1))).Interior.ColorIndex = 3
End If
Next cc
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
leere Zellen ohne Farbe
14.01.2013 07:31:02
Erich
Hi,
so werden die leeren Zellen nicht mit eingefärbt:

Sub Schlechter2b()
Dim rngB As Range, arQ, arT(), cc As Long, nn As Long
Set rngB = Range("E3:W3")     ' hier Bereich (in einer Zeile)
arQ = rngB
ReDim arT(1 To UBound(arQ, 2), 1 To 2)
For cc = 1 To UBound(arQ, 2)
If Not IsEmpty(arQ(1, cc)) Then
nn = nn + 1
arT(nn, 1) = cc + rngB.Column - 1
arT(nn, 2) = arQ(1, cc)
End If
Next cc
rngB.Interior.ColorIndex = xlColorIndexNone
For cc = 1 To nn - 2
If arT(cc, 2) > arT(cc + 1, 2) And _
arT(cc + 1, 2) > arT(cc + 2, 2) Then _
Union(Cells(rngB.Row, arT(cc, 1)), _
Cells(rngB.Row, arT(cc + 1, 1)), _
Cells(rngB.Row, arT(cc + 2, 1))).Interior.ColorIndex = 3
Next cc
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: leere Zellen ohne Farbe
14.01.2013 13:01:27
Maximilian
Hammer, funktioniert! Vielen Dank!!!

Danke für deine Rückmeldung, aber ...
14.01.2013 19:33:34
Erich
Hi,
... warum hast du diesen Thread wieder auf "offen" gestellt? Deine Frage ist doch beantwortet.
Lies doch bitte mal, was neben dem Kontrollkästchen zu "offen" steht...
Grüße aus Kamp-Lintfort von Erich

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige