• 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.

Range uitbreiden

Status
Niet open voor verdere reacties.

Bramzzz

Gebruiker
Lid geworden
3 dec 2004
Berichten
272
Goedemiddag,

Ik heb onderstaande code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim color As Integer

If ActiveSheet.Range("A1").Interior.ColorIndex > 0 Then color = 5

If color = 5 Then ActiveSheet.Range("A2").Value = 5

If ActiveSheet.Range("A1").Interior.ColorIndex = xlNone Then color = 0

If color = 0 Then ActiveSheet.Range("A2").Value = 0

End Sub



Als in cel A1 een kleur wordt ingevuld dan verschijnt in cel A2 een ''5''.
Nu wil ik de range uitbreiden over 192 kolommen. (A1:GJ1)
Als in A1 een willekeurige kleur wordt ingevuld moet in A2 een ''5'' verschijnen. Als in B1 een kleur wordt ingevuld moet in B2 een ''5'' verschijnen, ETC.

Kunnen jullie me hierbij helpen? Ik kom er niet uit.

Alvast bedankt!
 
Bramzzz,

Je ben al zolang lid, dan zou je toch zeggen dat je weet dat de code tussen de code tags moet staan.

Probeer dit eens, kijk of het doe wat je wil.
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
Dim color As Integer
If Target.Row >= 2 Then Exit Sub
If Target.Row = 1 Then
  With ActiveCell
    If Target.Interior.ColorIndex > 0 Then Target.Interior.ColorIndex = 5
      .Offset(1, 0).Value = 5
    If Target.Interior.ColorIndex = xlNone Then color = 0
      .Offset(1, 0).Value = 0
  End With
End If

End Sub
 
Haha ja ben wel al een tijdje lid maar ben meer van de hardware eigenlijk.
Toevallig was ik voor mn werk ff in excel iets aan het maken maar doe dat verder nooit eigenlijk.
Maar bedankt, het werkt!
 
Misschien werkt dit beter?
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
Dim color As Integer
If Target.Row >= 2 Then Exit Sub
If Target.Row = 1 Then
  With ActiveCell
    If Target.Interior.ColorIndex = xlNone Then Exit Sub
    If Target.Interior.ColorIndex > 0 Then Target.Interior.ColorIndex = 5
      .Offset(1, 0).Value = 5
  End With
End If

End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan