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

Bedingte Formatierung mit VBA

Bedingte Formatierung mit VBA
Christina
Guten Morgen,
Beginnend in Zelle B6 stehen nach unten Werte.
Die 4 größten Werte sollen nun mit unterschiedlichen Füllfarben hinterlegt werden.
Wie kann man diese Aufgabe mit VBA umsetzen?
Gruß
Christina Verena

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Bedingte Formatierung mit VBA
09.10.2011 11:03:14
Josef

Hallo Christina,
warum VBA? das geht doch ganz einfach per bedingter Formatierung.
Als Code z. B. so.

Sub Christina()
  Dim rng As Range, rngAll As Range
  Dim vntRet As Variant
  
  Set rngAll = Range("B6:B" & Application.Max(6, Cells(Rows.Count, 2).End(xlUp).Row))
  
  rngAll.Interior.ColorIndex = xlNone
  
  On Error Resume Next
  
  For Each rng In rngAll
    If IsNumeric(rng) Then
      If rng = Application.Large(rngAll, 1) Then rng.Interior.ColorIndex = 4
      If rng = Application.Large(rngAll, 2) Then rng.Interior.ColorIndex = 5
      If rng = Application.Large(rngAll, 3) Then rng.Interior.ColorIndex = 6
      If rng = Application.Large(rngAll, 4) Then rng.Interior.ColorIndex = 3
    End If
  Next
  
  On Error GoTo 0
  
  Set rngAll = Nothing
End Sub



« Gruß Sepp »

Anzeige
Danke und Zusatzfrage
09.10.2011 11:16:17
Christina
Hallo Sepp,
vielen Dank für Deine Lösung.
An meinem "Programm" erkennst Du, dass ich noch zur Gruppe "Anfängerinnen" gehöre.

Sub Bedingte_Formatierung()
Dim z As Integer
For z = 6 To 14
If Cells(z, 2) = Application.Large(Range("B6:B14"), z - 5) Then Cells(z, 2).Interior.ColorIndex  _
= 5
If Cells(z, 2) = Application.Large(Range("B6:B14"), z - 4) Then Cells(z, 2).Interior.ColorIndex  _
= 8
If Cells(z, 2) = Application.Large(Range("B6:B14"), z - 3) Then Cells(z, 2).Interior.ColorIndex  _
= 11
If Cells(z, 2) = Application.Large(Range("B6:B14"), z - 2) Then Cells(z, 2).Interior.ColorIndex  _
= 14
Next z
End Sub
Kannst Du mir mitteilen, weshalb Laufzeitfehler 13 Typen unverträglich erscheint?
Wie man diesen Ansatz uU lauffähig machen kann?
Gruß
Christina Verena
Anzeige
AW: Danke und Zusatzfrage
09.10.2011 11:20:03
Josef

Hallo Christina,
weil wahrscheinlich weniger als 12 verschiedene Werte in B6:B14 stehen und es kein KGRÖSSTES 12 gibt.

« Gruß Sepp »

Besser so.
09.10.2011 11:14:43
Josef

Sub Christina()
  Dim rng As Range, rngAll As Range
  Dim dblValues(3) As Double, lngIndex As Long, lngC As Long
  
  Set rngAll = Range("B6:B" & Application.Max(6, Cells(Rows.Count, 2).End(xlUp).Row))
  
  rngAll.Interior.ColorIndex = xlNone
  
  On Error Resume Next
  
  Do
    lngC = lngC + 1
    If IsError(Application.Match(Application.Large(rngAll, lngC), dblValues, 0)) Then
      dblValues(lngIndex) = Application.Large(rngAll, lngC)
      lngIndex = lngIndex + 1
    End If
  Loop While lngIndex < 4
  
  For Each rng In rngAll
    Select Case rng
      Case dblValues(0): rng.Interior.ColorIndex = 4
      Case dblValues(1): rng.Interior.ColorIndex = 5
      Case dblValues(2): rng.Interior.ColorIndex = 6
      Case dblValues(3): rng.Interior.ColorIndex = 3
    End Select
  Next
  
  On Error GoTo 0
  
  Set rngAll = Nothing
End Sub



« Gruß Sepp »

Anzeige
AW: Besser so und weshalb?
09.10.2011 12:04:31
Christina
Hallo Sepp,
herzlichen Dank für die beiden Lösungen.
Verrätst Du mir noch, weshalb die zweite Variante die bessere ist?
Dank im Voraus.
Gruß
Christina Verena
AW: Besser so und weshalb?
09.10.2011 12:29:05
Josef

Hallo Christina,
weil bei doppelten Werten die erste Variante ein falsches Ergebnis liefern kann.

« Gruß Sepp »

Anzeige
Aha, danke
09.10.2011 12:43:42
Christina
Hallo Sepp.
vielen Dank für Deine guten Ideen und Deine Geduld.
Du hast mir damit eine Freude bereitet, habe ich doch wieder ein Stück dazu gelernt.
Einen schönen Sonntag.
Gruß
Christina Verena
Da ist doch noch eine Frage zu ...
09.10.2011 14:33:01
Christina
Hallo Sepp,
es ist doch noch eine Frage aufgetaucht zu diesen 2 Zeilen:
On Error Resume Next 'Bei einem Fehler geht es mit der nächsten Zeile weiter
' ohne dass eine Fehlermeldung angezeigt wird. Diese
' wird unterdrückt
On Error GoTo 0 'Fehlerbehandlungsroutine wird deaktiviert
Mit welchem Fehler hätte man denn eventuell rechnen müssen?
Gruß
Christina Verena
Anzeige
AW: Da ist doch noch eine Frage zu ...
09.10.2011 16:27:34
Josef

Hallo Christina,
schreib mal weniger als vier unterschiedliche Werte in den Bereich und nimm "On Error Resume Next" mal raus, dann siehst du, dass eine Fehlermeldung kommt.
Natürlich könnte man vorher auch ermitteln, wie viele unterschiedliche Werte vorkommen, aber in diesem Fall ist das nicht unbedingt zwingend.

« Gruß Sepp »

Anzeige
Testergebnis
09.10.2011 17:34:08
Christina
Hallo Sepp,
On Error Resume Next als Kommentar gesetzt und neu gestartet brachte keine Fehlermeldung.
Die Liste hatte 2 unterschiedliche Werte, der größte erhielt die Farbe grun, alle anderen die Farbe rot.
Frage; Wann sollte man diesen Fehlermeldungsunterdrückuingsbefehl - bestimmt kein gängiger DV-Begriff - einsetzen?
Gruß
Christina Verena
AW: Testergebnis
09.10.2011 17:43:49
Josef

Hallo Christina,
am besten gar nicht;-)) - oder so wie ich, bei einem unkritischen Code, wo das Abfangen des Fehlers mehr Aufwand macht als der restliche Code.

« Gruß Sepp »

Anzeige
OK! Danke
09.10.2011 18:06:17
Christina
Hallo Sepp,
Verstanden.
Danke
Gruß
Christina Verena
Das Nicht-Abfangen eines Fehlers führt bei ...
11.10.2011 01:29:24
Luc:-?
…geschütztem VBA-Projekt zu unschönen Fehlermeldungen, Sepp,
also besser dafür eigene Fehlermeldung schreiben. ;-)
Gruß Luc :-?
PS: Ich hätte nicht die Zelle gefärbt, sondern tatsächlich bedingte Formatierungen gesetzt, ggf auch per VBA. Das vereinfacht das „Rückfärben” bei dynamischen Tabellen, also falls die formatierten Werte mit Fmln erzeugt wdn.

327 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige