Office: VBA | Zelle auslesen,vergleichen und Hintergrund Zelle färben

aslan · 17. Dezember 2017

Hallo,
es klingt einfach aber ich komm einfach nicht zur Lösung.
Ich bräuchte für folgendes ein makro.

Es soll in Spalte A nach "geplant" suchen, wenn gefunden dann suche von in der Zeile wo "geplant" gefunden wurde die 1 in Zeile B58 bis V58
wenn die 1 zB in zelle D58 gefunden wurde dann vergleiche zelle D57 wenn Zahl in Zelle D57 kleiner als 3 ist dann färbe Zelle D58 mit roten hintergrund und wenn die Zelle D57 gleich 3 ist dann färbe Zelle D58 mit grünen hintergrund.

wenn das mit einem makro funktioniert wäre es genial

Hoffe das einer helfen kann.

Vielen Dank
aslan

:)

Beverly · 19. Dezember 2017

Hi,

meinst du so etwas:

Code:

Sub Faerben()
Dim rngZelle As Range
Dim rngSpalte As Range
Set rngZelle = Columns(1).Find("geplant", lookat:=xlWhole)
If Not rngZelle Is Nothing Then
Set rngSpalte = Range(rngZelle.Offset(0, 1), rngZelle.Offset(0, 21)).Find(1, lookat:=xlWhole)
If Not rngSpalte Is Nothing Then
If rngSpalte.Offset(0, -1) < 3 And rngSpalte.Offset(0, -1) > 1 Then
rngSpalte.Interior.ColorIndex = 3
ElseIf rngSpalte.Offset(0, -1) = 3 Then
rngSpalte.Interior.ColorIndex = 4
Else
rngSpalte.Interior.ColorIndex = xlNone
End If
End If
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Beachte: die Zahl in der Nachbarzelle links muss > 1 sein, um sie mit 1 vergleichen zu können.

aslan · 19. Dezember 2017

ist schon mal echt gut, schau dir mal die angehängte datei hoffe das es so verständlicher aussieht.

https://workupload.com/file/hHpZCbh

sorry das password ist aslan

Beverly · 19. Dezember 2017

Lade die Mappe bitte hier im Forum hoch - findest du wenn du unterhalb des Antwortfensters den Schalter "Erweitert" drückst und dann auf "Anhänge verwalten" gehst.

aslan · 19. Dezember 2017

\@ beverly danke für die Info *Smilie

habs nun angehängt.

Danke

aslan · 22. Dezember 2017

Hmm klappts mit der Datei? *Smilie

aloys78 · 22. Dezember 2017

Hallo Aslan,

anbei mein Vorschlag, dem folgende Annahmen zugrundeliegen:

in einer Zeile kommt nur einmal die 1 vor

in der Tabelle kann in Sp A mehrmals "geplant" vorkommen; macht aber nichts, wenn diese Annahme nicht stimmt.

Code:

Option Explicit

Sub Zellen_färben()
Dim r As Long ' Zeilen#
Dim c As Long ' Spalten#
Dim LRow As Long ' Nr letzte Zeile
Dim rng As Range ' Ergebnis Find
Dim rng2 As Range ' zu färbende Zelle
Dim sh As Worksheet ' Sheet1
Dim firstaddress As String ' erste gefundene Adresse bei Find
Dim erg As Variant ' Ergebnis Match

Set sh = Worksheets("Sheet1")
LRow = sh.Cells(Rows.Count, "A").End(xlUp).Row

With sh.Range("A5:A" & LRow)
Set rng = .Find("geplant", LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then
firstaddress = rng.Address
Do
r = rng.Row
erg = Application.Match(1, sh.Range("B" & r & ":V" & r), 0)
If IsNumeric(erg) Then
c = erg + 1
Set rng2 = sh.Cells(r - 1, c)
Select Case rng2
Case Is < 3 ' rot färben
rng2.Interior.ColorIndex = 3
Case Is = 3 ' grün färben
rng2.Interior.ColorIndex = 4
Case Else
rng2.Interior.ColorIndex = xlNone
End Select
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address firstaddress
End If
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß
Aloys

hary · 22. Dezember 2017

Moin
Bezogen auf deine Bsp.-Mappe in #5
Code:

Sub Faerben()
Dim a As Variant
Dim Bereich As Range, Zelle As Range
a = Application.Match("geplant", Columns(1), 0)
If IsNumeric(a) Then
Set Bereich = Cells(a, 2).Resize(1, 21)
Bereich.Offset(-1, 0).Interior.Color = xlNone
For Each Zelle In Bereich
If Zelle "" Then
With Zelle.Offset(-1, 0)
If .Value < Zelle * 3 Then
.Interior.Color = vbRed
ElseIf .Value = Zelle * 3 Then
.Interior.Color = vbGreen
End If
End With
End If
Next
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Moin Aloys wuensche ein frohes Fest
Case ist aber nicht immer 3
lt Mappe in #5 sind es 3 / 6 und 9
Kann auch sein dass ich deinen Code, am fruehen Morgen, falsch lese. Bin noch Hundemuede.
gruss hary

aloys78 · 22. Dezember 2017

Hallo Hary,

... wuensche ein frohes Fest
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das wünsche ich Dir auch.

Ansonsten warst Du ausgeschlafener als ich.
Ich war damit beschäftigt, Salate für heute mittag vorzubereiten; da hatte ich vermutlich Tomaten auf den Augen, so dass ich den 2. Teil der Aufgabenstellung aus den Augen verlor.

Ich verzichte auf Nachbesserung, da Deine Lösung ja funktioniert. Offen ist für mich noch, ob es nur um eine Suchzeile geht.

Gruß Aloys

Beverly · 22. Dezember 2017

Hi,

ich bin kein Frühaufsteher *grins, deshalb erst jetzt mein Vorschlag:

Code:

Sub Faerben()
Dim rngZelle As Range
Dim intSpalte As Integer
Dim bytZaehler As Byte
Set rngZelle = Columns(1).Find("geplant", lookat:=xlWhole)
If Not rngZelle Is Nothing Then
For intSpalte = 2 To IIf(IsEmpty(Cells(rngZelle.Row, Columns.Count)), _
Cells(rngZelle.Row, Columns.Count).End(xlToLeft).Column, Columns.Count)
Select Case Cells(rngZelle.Row, intSpalte)
Case 1, 2, 3
If Cells(rngZelle.Row - 1, intSpalte) < 3 * Cells(rngZelle.Row, intSpalte).Value Then _
Cells(rngZelle.Row - 1, intSpalte).Interior.ColorIndex = 3
If Cells(rngZelle.Row - 1, intSpalte) = 3 * Cells(rngZelle.Row, intSpalte).Value Then _
Cells(rngZelle.Row - 1, intSpalte).Interior.ColorIndex = 4
Case Else
Cells(rngZelle.Row, intSpalte).Interior.ColorIndex = xlNone
End Select
Next intSpalte
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: VBA | Zelle auslesen,vergleichen und Hintergrund Zelle färben

VBA | Zelle auslesen,vergleichen und Hintergrund Zelle färben

VBA | Zelle auslesen,vergleichen und Hintergrund Zelle färben

VBA | Zelle auslesen,vergleichen und Hintergrund Zelle färben

VBA | Zelle auslesen,vergleichen und Hintergrund Zelle färben

VBA | Zelle auslesen,vergleichen und Hintergrund Zelle färben - Similar Threads - VBA Zelle auslesen

Bereich im VBA Code aus Zelle auslesen

VBA Teil einer Zelle von rechts auslesen

VBA: Werte aus Zellen mit Zeilenumbruch auslesen

Datum aus Zelle auslesen (VBA)

Wert von ausgewählter Zelle in Pivot-Tabelle per VBA auslesen

VBA Formel die automatisch die Zelle nach dem Namen zusammenrechnet

Einzelne Zellen auslesen/exportieren per VBA