Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1224to1228
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

Farbfelder übertragen wenn ID gleich

Farbfelder übertragen wenn ID gleich
Matthias
Guten Morgen Excelfreunde,
meine VBA Kenntnisse sind noch dürftig und ohne diese wird es nicht gehen,
also suche ich wieder einmal Rat bei Euch.
Es soll eine ID verglichen werden, wenn diese übereinstimmt, wird in der nebenstehenden Spalte
Die Zelle je nach Bedingung eingefärbt. Ich habe eine abgespeckte Musterdatei beigefügt schaut es
Euch bitte einmal an.
Ich freue mich auf Eure zusammenarbeit.
Anlage: https://www.herber.de/bbs/user/76337.xlsm
Gruß Matze

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Bedingtes Format - ohne VBA
24.08.2011 08:05:03
Erich
Hi Matze,
warum sollte das nicht ohne VBA gehen? Excel gut?
Ein Vorschlag:
Tabelle1

 ABC
2IDStk-ZahlMin
31312572
419125 
523130-66
614100-32
71710088
818120122
92210069

Formeln der Tabelle
ZelleFormel
C3{=WENN(ISTNV(VERGLEICH(A3;$A$15:$A$20;0)); "";MIN(WENN($A$15:$A$20=A3;$B$15:$F$20)))}
Enthält Matrixformel:
Umrandende
{ } nicht miteingeben,
sondern Formel mit STRG+SHIFT+RETURN abschließen!
Matrix verstehen

Bedingte Formatierungen der Tabelle
ZelleNr.: / BedingungFormat
B31. / Formel ist =$C3<0Abc
B32. / Formel ist =$C3<=75Abc
B41. / Formel ist =$C3<0Abc
B42. / Formel ist =$C3<=75Abc
B51. / Formel ist =$C3<0Abc
B52. / Formel ist =$C3<=75Abc
B61. / Formel ist =$C3<0Abc
B62. / Formel ist =$C3<=75Abc
B71. / Formel ist =$C3<0Abc
B72. / Formel ist =$C3<=75Abc
B81. / Formel ist =$C3<0Abc
B82. / Formel ist =$C3<=75Abc
B91. / Formel ist =$C3<0Abc
B92. / Formel ist =$C3<=75Abc

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
VBA Lösung gesucht - Danke Erich
24.08.2011 09:03:06
Matthias
Da hätte der Matze ja selbst drauf kommen können,
prima , ich würde aber gerne offen lassen und mir eine VBA Lösung ansehen-
Danke
Gruß Matze
AW: VBA Lösung gesucht - Danke Erich
24.08.2011 11:51:00
Tino
Hallo,
hier mal eine Variante, evtl. müsstest Du die Bereiche und die Tabelle anpassen
wenn es nicht wie im Beispiel aufgebaut ist.
Sub Test()
Dim ArrayData, n&, nn&, nnn&, nMaxColor&, lngColor&
Dim rng As Range
Dim iCalc%

Const lngRot& = 255
Const lngOrange& = 49407

With Tabelle1 'tabelle anpassen 
    ArrayData = .Range("A15", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 6)
    Set rng = .Range("A3", .Cells(3, 1).End(xlDown)).Resize(, 2)
End With

With Application
    iCalc = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    
        With .WorksheetFunction
            nMaxColor = .Max(lngRot, lngOrange) + 1
            
            For n = 1 To rng.Rows.Count
                lngColor = nMaxColor
                For nn = 1 To Ubound(ArrayData)
                    If ArrayData(nn, 1) = rng(n, 1).Value Then
                        For nnn = 2 To Ubound(ArrayData, 2)
                            Select Case ArrayData(nn, nnn)
                                Case Is < 0
                                    lngColor = lngRot 'rot 
                                    Exit For
                                Case 0 To 75
                                    lngColor = .Min(lngColor, lngOrange) 'orange 
                            End Select
                        Next nnn
                        Exit For
                    End If
                Next nn
                
                If lngColor = nMaxColor Then lngColor = xlColorIndexNone
                rng(n, 2).Interior.Color = lngColor
            Next n
        End With
    
    .Calculation = iCalc
    .ScreenUpdating = False
    .EnableEvents = False
End With
End Sub
Gruß Tino
Anzeige
Wenn's VBA sein soll...
24.08.2011 11:57:18
Erich
Hi Matze,
... dann probier mal

Option Explicit
Sub Faerbe()
Dim rngC As Range, arrID, varF, dblM As Double
arrID = Range(Cells(15, 1), Cells(15, 1).End(xlDown))
For Each rngC In Range(Cells(3, 1), Cells(3, 1).End(xlDown))
varF = Application.Match(rngC, arrID, 0)
If IsNumeric(varF) Then
dblM = Application.Min(Cells(14 + varF, 2).Resize(, 5))
Select Case dblM
Case Is 
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Danke euch Beiden
24.08.2011 12:02:32
Matthias
Werde mir das erst heute Abend ansehen können,
sieht aber vielversprechend aus, somit hab ich wieder was zu lernen.
Danke... werde dieses Forum immer gerne weiterempfehlen.
Gruß Matze
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige