Font Color VBA

[Eggie]

Hallo,

ik heb een excel file met twee sheets. Op deze twee sheets staat exact dezelfde data, enkel zijn op de 2e sheet op enkele regels veranderd qua font color (van zwart = fontcolor 0 naar blauw = font colorindex 5).

Nu zou ik graag op een derde sheet de waarde van kolom A van de 2e sheet willen zien enkel indien font color op sheet 1 zwart is en op sheet 2 blauw is, anders mag de cel leeg blijven.

Dus ter verduidelijking: Stel

Sheet 1 regel 10 is zwart
Sheet 2 regel 10 is blauw
Dan op sheet 3 cel A10 de waarde van Sheet 2 cel A10

Graag zou ik hier een macro voor willen hebben zodat de veranderingen worden gecalculeerd...

Alvast bedank voor de moeite!!!

Mvg,

Eggie

 

[Wigi]

Excel denkt in termen van databases (dus gevulde cellen in een rechthoekige vorm van rijen en kolommen, met kolomhoofdingen). En Excel denkt niet in termen van kleurtjes.

Met een deftige tabel-layout is zoiets kopiëren niet moeilijk: filteren en overkopiëren. Als je met kleurtjes gaat werken, werkt zoiets niet en moet je allerlei lussen gaan programmeren. Ook niet echt moeilijk, maar niet efficiënt en niet hoe Excel denkt.

Waarom je eigenlijk 2 bijna identieke bladen hebt is mij een raadsel. Waarom geen extra kolom in het eerste blad erbij met een 1 of 0 of iets dergelijks? Daar kun je met een autofilter op filteren en heb je dat hele kopieergedoe zelfs niet nodig.

Van beide gevallen staan er al massa's voorbeelden op het forum.

Wigi

 

[Wigi]

Hier dan een lus maar het mag duidelijk zijn dat er véél betere manieren zijn voor dit soort problemen (zie posts hierboven).

Sub blauwzwart()

    Dim lRij As Long
    
    Dim blad1 As Worksheet
    Dim blad2 As Worksheet
    Dim blad3 As Worksheet
    
    '-----------'
    ' aanpassen '
    '-----------'
    Set blad1 = ThisWorkbook.Sheet1
    Set blad2 = ThisWorkbook.Sheet2
    Set blad3 = ThisWorkbook.Sheet3
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    For lRij = 1 To blad1.Range("A" & Rows.Count).End(xlUp)

        If blad1.Range("A" & lRij).Font.ColorIndex = 0 And _
           blad2.Range("A" & lRij).Font.ColorIndex = 5 Then
                
                blad3.Cells.ClearContents
                blad3.Range("A" & lRij).Value = blad2.Range("A" & lRij).Value
           
        End If

    Next
    
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic

End Sub

Wigi