Sudoko

[caffie]

Stel ik sta ik me sudoko veld op een cel met een getal (3)
Dan wil ik graag alle horizontale en verticale lijnen kleuren met het zelfde getal binnen me sudoko puzzel
En als deze geen waarde heeft alleen de horizontale en vertikale van de active cel inkleuren



vast heel erg bedankt

 

[edmoor]

Niet echt duidelijk wat je wilt.
Met horizontale en verticale lijnen bedoel je neem ik aan rijen en kolommen?
Of wil je alleen de cellen met hetzelfde nummer kleuren?
Dan gaat het om het getal in C5?

N.B.:
Het is Sudoku.

 

[VenA]

Misschien zo?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim r As Range, cl As Range
  Set r = Range("E5:M13")
  If Target.Count <> 1 Then Exit Sub
  If Intersect(Target, r) Is Nothing Or Target = "" Then Exit Sub
    r.Interior.Color = vbWhite
    For Each cl In r
      If cl.Value = Target.Value Then cl.Interior.Color = vbYellow
    Next cl
End Sub

Zelf zou ik het Change event gebruiken die na invoer wat gaat controleren.

 

[caffie]

ik heb de sheet weer toe gevoegd met macro
met voorbeeld
ik wil dus graag in de sheet een nummer selecteren (bv nummer 1) waarop alle rijen en kolomen in het sudoku veld gekleurd worden
ik heb een voorbeeld eronder gekopieerd (wat ik handmatig heb ingekleurd)
op deze manier kan je dus zien dat ik het eerste kwadrant maar 1 positie overblijft waar dus een 1 moeten komen.

op die manier probeer ik de puzzel op te lossen


vast bedankt

 

[HSV]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim r As Range, c As Range, firstaddress As String
  Set r = Range("E5:M13")
  If Target.Count <> 1 Then Exit Sub
  If Intersect(Target, r) Is Nothing Or Target = "" Then Exit Sub
       r.Interior.Color = vbWhite
       Set c = r.Find(Target, , , 1)
       firstaddress = c.Address
      Do
        r.Cells(1, c.Column - 4).Resize(9).Interior.Color = vbYellow
        r.Cells(c.Row - 4, 1).Resize(, 9).Interior.Color = vbYellow
        Set c = r.FindNext(c)
      Loop While Not c Is Nothing And c.Address <> firstaddress
End Sub

 

[popipipo]

Hier een oplossing met VO
Behalve rijen en kolommen heb ik ook nog vakjes van 3 bij 3 toegevoegd.
Alles wel met wat hulp cellen.

 

[HSV]

Nog eentje met Vw-opmaak.
Wel één regel Vba om het te laten herberekenen.

 

[caffie]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim r As Range, c As Range, firstaddress As String
  Set r = Range("E5:M13")
  If Target.Count <> 1 Then Exit Sub
  If Intersect(Target, r) Is Nothing Or Target = "" Then Exit Sub
       r.Interior.Color = vbWhite
       Set c = r.Find(Target, , , 1)
       firstaddress = c.Address
      Do
        r.Cells(1, c.Column - 4).Resize(9).Interior.Color = vbYellow
        r.Cells(c.Row - 4, 1).Resize(, 9).Interior.Color = vbYellow
        Set c = r.FindNext(c)
      Loop While Not c Is Nothing And c.Address <> firstaddress
End Sub

Hallo Harry dit is wat ik zocht
werk perfect
kunt u ook uitleggen in Jip en Janneke taal
hoe ik met u variabele ook een kwadrant kan gaan markeren


als ik dus een cijfer markeer moet het gehele kwadrant ook ingekleurd worden

 

[HSV]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim r As Range, c As Range, firstaddress As String
  Set r = Range("E5:M13")
  If Target.Count <> 1 Then Exit Sub
  If Intersect(Target, r) Is Nothing Or Target = "" Then Exit Sub
       r.Interior.Color = vbWhite
[COLOR=#0000ff]       r.Cells(((Target.Row - 5) \ 3) * 3 + 1, ((Target.Column - 5) \ 3) * 3 + 1).Resize(3, 3).Interior.Color = vbYellow[/COLOR]
       Set c = r.Find(Target, , , 1)
       firstaddress = c.Address
      Do
        r.Cells(1, c.Column - 4).Resize(9).Interior.Color = vbYellow
        r.Cells(c.Row - 4, 1).Resize(, 9).Interior.Color = vbYellow
        Set c = r.FindNext(c)
      Loop While Not c Is Nothing And c.Address <> firstaddress
End Sub

 

[caffie]

wederom bedankt