• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Cel in Kolom A rood kleuren

Status
Niet open voor verdere reacties.

Gert Bouwmeeste

Verenigingslid
Lid geworden
28 nov 2007
Berichten
827
Ik heb een bestand met een 83-tal kolommen en honderden regels. Dat bestand wordt maandelijks (door anderen) gemuteerd.

Om te bepalen wat er in een maand veranderd is maak ik gebruik van een invoegtoepassing, Spreadsheet Compare. Dat werkt prima. De cellen die veranderd zijn ten opzichte van een maand vroeger worden keurig netjes rood gemarkeerd.
Maar ... hoe kan ik nu de gemarkeerde cellen snel terugvinden?

Ik kan "filteren op kleur" maar dan moet ik 83 kolommen aflopen om te kijken of er daar iets van kleur is veranderd.

Handig zou zijn om de cel in kolom A (lidnummer) rood te kleuren indien er ergens op die regel een cel een rode achtergrondkleur heeft.

Dus als ergens op een regel de achtergrondkleur van een cel ".Interior.Color = 2 (rood)" is dan moet de cel in kolom A van die regel ook de .Interior.Color = 2 krijgen.

Wie kan mij hiermee even op weg helpen?

Dank!
 
Laatst bewerkt:
en hoe word de cel nu rood gekleurd?
Kan dan misschien met zelfde VO?
 
Marco,

De cel wordt rood gekleurd door de invoegtoepassing Spreadsheet Compare. Daar kan ik niks mee. Ik kan de code wel bekijken maar dat is zo ingewikkeld (voor mij dan), daar kom ik niet uit.

De complete code staat in dit PDF-bestand.
 

Bijlagen

Opgelost met deze macro. Niet de schoonheidsprijs (want gebruik v SELECT etc) maar t werkt wel.

Code:
Sub KleurGemuteerdLid()
'
' Deze macro kleur het Lidnr in Kolom A nadat bestanden vergeleken zijn
' met Spreadsheet Compare
    
    'Ga naar liksboven
        Range("A1").Select
    
    'Bereken het aantal kolommen
        If WorksheetFunction.CountA(Cells) > 0 Then
            LaatsteKolom = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        End If
  
    'Bereken het aantal regels
    
        AantalRegels = Application.WorksheetFunction.CountA([A2:A10000])
    
    'Doorloop alle regels
    
        For AantalLeden = 1 To AantalRegels                                     'Herhaal de FOR-NEXT net zo vaak als er leden zijn
            For Herhalen = 2 To LaatsteKolom                                    'Herhaal deze FOR-NEXT net zo vaak als er kolommen zijn.
                If ActiveCell.Interior.Color <> 255 Then                        'Als de huidige cel in kolom A al rood is, dan stop dit lid
                    If ActiveCell.Offset(0, Herhalen).Interior.Color = 255 Then 'Als de celkleur (.Interior.Color) van de cel in de kolom rood is,
                        ActiveCell.Interior.Color = 255                         '   maak dan de cel in kolom A ook rood.
                    End If
                End If
            Next
            ActiveCell.Offset(1, 0).Range("A1").Select                          'Ga één regel naar beneden
        Next
    
    'Ga naar Home en Filter op Rood
        Range("A1").Select
        ActiveSheet.Range("$A$1:$ZZ$10000").AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
        
End Sub
 
het zou ook zo kunnen denk ik
Code:
Sub KleurGemuteerdLid()
'
' Deze macro kleur het Lidnr in Kolom A nadat bestanden vergeleken zijn
' met Spreadsheet Compare
    
   
    
    'Bereken het aantal kolommen
        laatstekolom = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Column
  
    'Bereken het aantal regels
    
        aantalregels = Application.WorksheetFunction.CountA([A2:A10000])
    
    'Doorloop alle regels
    
    For a = 1 To aantalregels
        For b = 2 To laatstekolom
            If Cells(a, b).Interior.Color = 255 Then Cells(a, 1).Interior.Color = 255
            
         Next
      Next
    
        ActiveSheet.Range("$A$1:$ZZ$10000").AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
        
End Sub
 
Laatst bewerkt:
Als het een aaneengesloten bereik is.

Code:
Sub VanA()
    ar = Cells(1).CurrentRegion
    For j = 1 To UBound(ar)
        For jj = 2 To UBound(ar, 2)
            If Cells(j, jj).Interior.Color = 255 Then
                Cells(j, 1).Interior.Color = 255
                Exit For
            End If
        Next jj
    Next j
    Columns(1).AutoFilter 1, RGB(255, 0, 0), xlFilterCellColor
End Sub
 
Status
Niet open voor verdere reacties.

Nieuwste berichten

Terug
Bovenaan Onderaan