Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

VBA Zellen einfärben | Herbers Excel-Forum


Betrifft: VBA Zellen einfärben von: WalterK
Geschrieben am: 26.07.2012 21:58:49

Hallo,

aus dem Internet (woher ist mir nicht mehr erinnerlich) habe ich einen Code erfragt, der bestimmte Zellen mit bestimmten Hintengrundfarben einfärbt.

Der Code funktioniert noch nicht optimal, darum wende ich mich an Euch.

Zur genauen Beschreibung des Problems habe ich eine Arbeitsmappe hochgeladen.

Hier die Datei:
https://www.herber.de/bbs/user/81172.xls

Besten Dank an die Helfer,
Servus, Walter

  

Betrifft: AW: VBA Zellen einfärben von: fcs
Geschrieben am: 26.07.2012 23:32:38

Hallo Walter,

so sollte es funktionieren.

Gruß
Franz

Sub LK_einfärben()

'Teil 1 - sucht die Spalte Bezeichnung und färbt Zellen mit identischem Text gleich ein,
'falls für diesen Text manuell eine Farbe hinterlegt wurde.
'Es soll eine MsgBox erscheinen, wenn die Überschrift BEZEICHNUNG fehlt oder überhaupt
'keine Zelle in der Spalte BEZEICHNUNG manuell farblich hinterlegt wurde.

  Dim rngBezeich As Range
  Dim Zelle As Range
  Dim myDic As Object
  Set myDic = CreateObject("scripting.Dictionary")
  Dim MyBool As Boolean, varBezeich As Variant, varBeginn As Variant, varEnde As Variant
  
  On Error GoTo ErrHandler:
  With ActiveSheet
    varBezeich = Application.Match("BEZEICHNUNG", .Rows(2), 0)
    varBeginn = Application.Match("JÄNNER", .Rows(2), 0)
    varEnde = Application.Match("DEZEMBER", .Rows(2), 0)
    If IsError(varBezeich) Then
        MsgBox "Spalte ""BEZEICHUNG"" nicht vorhanden", _
            vbInformation, "Makro: LK_einfärben"
        GoTo ErrHandler
    End If
    Application.ScreenUpdating = False

    Set rngBezeich = Intersect(.Range("A2").CurrentRegion, _
                               .Rows(2).Find("BEZEICHNUNG").EntireColumn)
    'gefärbte Zellen ermitteln
    For Each Zelle In rngBezeich
      If Zelle.Interior.ColorIndex <> xlColorIndexNone Then
        If Not myDic.exists(Zelle.Value) Then
            myDic(Zelle.Value) = Zelle.Interior.Color
            MyBool = True
        End If
      End If
    Next
    If MyBool = False Then
      MsgBox "In Spalte ""BEZEICHNUNG"" sind keine Zellen eingefärbt", _
            vbInformation, "Makro: LK_einfärben"
      GoTo ErrHandler
    End If
    
    'Zellen gleicher Bezeichung und Bereich JÄNNER bis DEZEMBER einfärben
    For Each Zelle In rngBezeich
      If myDic.exists(Zelle.Value) Then
'***Teil 1 - Zellen in Spalte "BEZEICHNUNG" färben
        Zelle.Interior.Color = myDic(Zelle.Value)
'***Teil 2 - färbt die Spalten von JÄNNER bis DEZEMBER ein.
        If Not (IsError(varBeginn) Or IsError(varEnde)) Then
          .Range(.Cells(Zelle.Row, varBeginn), .Cells(Zelle.Row, varEnde)).Interior.Color _
              = myDic(Zelle.Value)
        End If
      End If
    Next
  End With
  If IsError(varBeginn) Or IsError(varEnde) Then
      MsgBox "In Zeile 2 fehlt die Überschrift JÄNNER oder DEZEMBER!", _
          vbInformation, "Makro: LK_einfärben"
  End If
ErrHandler:
  If Err.Number <> 0 Then
    MsgBox "Sonstiger Fehler-Nr.: " & Err.Number & vbCr _
                & Err.Description, vbCritical, "Makro: LK_einfärben"
  End If
  Application.ScreenUpdating = True
End Sub



  

Betrifft: AW: VBA Zellen einfärben von: WalterK
Geschrieben am: 27.07.2012 08:51:16

Hallo Franz,

besten Dank für Deine Hilfe, alles (bis auf eine Kleinigkeit) funktioniert genauso wie ich es haben wollte.

die Kleinigkeit: wenn in der Spalte Bezeichnung ab Zeile 3 noch keine Farbe hinterlegt wurde sollte eine entsprechende MsgBox angezeigt werden.

Nochmals Danke und Servus, Walter


  

Betrifft: bist Du Dir da wirklich sicher ? von: Matthias L
Geschrieben am: 27.07.2012 09:28:11

Hallo Walter



Gruß Matthias


  

Betrifft: AW: bist Du Dir da wirklich sicher ? von: WalterK
Geschrieben am: 27.07.2012 09:42:00

Hallo Matthias,

Du hast recht, es funktioniert.

Bei mir hat es nicht funktioniert, weil ich übersehen und auch vergessen habe zu erwähnen, dass in der Originaltabelle die Zeilen 1 und 2 schon eingefärbt sind wenn ich sie erhalte.

Was muss ich im Code ändern, damit bei der Prüfung, ob in der Spalte Bezeichnung schon Farben hinterlegt sind, die Zeilen 1 und 2 außer acht gelassen werden.

Besten Dank für Deine Hilfe, Servus Walter


  

Betrifft: AW: bist Du Dir da wirklich sicher ? von: fcs
Geschrieben am: 27.07.2012 09:58:19

Hallo Walter,

passe die Zeile mit "Set rngBezeich =" wie folgt an, damit nur die Zeilen ab Zeile 3 bearbeitet werden.

    Set rngBezeich = .Range(.Cells(3, varBezeich), .Cells(.Rows.Count, varBezeich).End(xlUp))

Gruß
Franz


  

Betrifft: Perfekt! Besten Dank! Servus Walter von: WalterK
Geschrieben am: 27.07.2012 10:04:33

.


Beiträge aus den Excel-Beispielen zum Thema "VBA Zellen einfärben"