buitenrand plaatsen rond willekeurige, aaneensluitende cellen

[arafy]

hallo,

ik wil de oplossingen die ik met pentomino gevonden heb, bijhouden in excel. het lukt me om de figuren in kleur te zetten, maar ik wil eigenlijk alleen de buitenrand. de kleuren verander ik met een macro en de randen wil ik ook met een macro doen (zonder kleur). het Z/W printen is niet duidelijk.

google heeft me nog niet verder geholpen.

de verschillende voorbeelden vind je in het bijgevoegd bestand.

groeten,

stevenBekijk bijlage vb pentomino.xlsx

 

[popipipo]

Via voorwaardelijke opmaak ben ik tot dit resultaat gekomen.
Vul cellen B8:K13 verder aan

Kun je hier verder mee?

 

[HSV]

Test deze code eens.

Sub hsv()
Dim j As Long, i As Long
 With Range("A8:J13")
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
  End With
  For j = 1 To 10
  For i = 8 To 13
   If Cells(i, j) <> Cells(i, j + 1) Then Cells(i, j).Borders(xlEdgeRight).ColorIndex = 0
   If Cells(i, j) <> Cells(i + 1, j) Then Cells(i, j).Borders(xlEdgeBottom).ColorIndex = 0
  Next i
 Next j
End Sub

 

[pixcel]

Wat popipipo doet met vo doet dit direct:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cl As Range
    If Target.Count > 10000 Then Exit Sub
    On Error Resume Next
    For Each cl In Target
        With cl
            .Borders(xlEdgeTop).LineStyle = IIf(.Offset(-1, 0).Value = .Value, xlNone, xlContinuous)
            .Borders(xlEdgeRight).LineStyle = IIf(.Offset(0, 1).Value = .Value, xlNone, xlContinuous)
            .Borders(xlEdgeBottom).LineStyle = IIf(.Offset(1, 0).Value = .Value, xlNone, xlContinuous)
            .Borders(xlEdgeLeft).LineStyle = IIf(.Offset(0, -1).Value = .Value, xlNone, xlContinuous)
        End With
    Next cl
    On Error GoTo 0
End Sub

Voor het beginkader is in bijlage wel vo gebruikt. Opm:
- dit heeft niets met pentominoes te maken, wel met inkaderen van celbereiken obv gelijke celwaarde, bijv om plattegronden te tekenen in een raster
- codes zijn niet relevant, je hebt aan vier codes genoeg (vierkleuren probleem)
- selecteer een bereik met cellen, en voer een waarde in met ctrl-enter
- als je een oplossing hebt gemaakt in het kader: selecteer het kader en kopieer/plak naar een andere plaats.

Bekijk bijlage pentomino.xlsm

 

[popipipo]

Ik had er voor gekozen om de letters pas te laten verdwijnen als alle cellen ingevuld zijn.
Op deze manier vind ik het onduidelijker wat je al hebt ingevuld.

 

[pixcel]

Op deze manier vind ik het onduidelijker wat je al hebt ingevuld.

Eens. De oplossing is een eenvoudige toggle: ctrl-a en en kies letterkleur automatisch of wit.

 

[popipipo]

Of je past je vba aan (mijn kennis schiet te kort) dat als alles gevuld is de letter kleur gelijk is aan de achtergrond kleur.
De oplossing van 'ctrl a' werkt natuurlijk wel maar ik vind het net zoiets als:

- dubbele ontkenning
- min maal min is plus
- een aanpassing doen omdat je daarvoor iets fouts heb gedaan.
Je moet de fout dus oplossen

 

[pixcel]

Ik zie het niet als een fout. Is de gebruiker altijd klaar als alles ingevuld is?
Dit soort opdrachten zou ik liever gebruiker-gestuurd laten. Evt mbv een aparte knop.
Maar Steven mag het zeggen.

 

[arafy]

dag allen,

alvast hartelijk dank voor de reacties. ik hoop morgen tijd te vinden om te kijken welke oplossing voldoet. ik heb per sheet 20 kaders en als ik 20 oplossingen heb voor een bepaalde combinatie, komt er een tweede pagina op die sheet.

groeten,

steven

 

[arafy]

ik vind de macro van harry de beste. het nadeel is dat de nog niet ingevulde kaders de rasterlijn hier ook verdwijnen.
er zou iets in de zin van

if cell(i,j)="" then next i

moet bij staan.
deze regel klopt wel niet, maar ik heb al drie jaar geen macro's meer geschreven en je vergeet veel .

groeten,

steven

 

[Roncancio]

Waarom geen gebruik maken van BorderAround?
Onderstaande code zet een dunne lijnen om het bereik A8 t/m J13.

Range("A8:J13").BorderAround , xlThin

Met vriendelijke groet,


Roncancio

 

[arafy]

Bekijk bijlage vb2 pentomino.xlsm

Roncancio,

misschien geeft volgend voorbeeld beter aan wat ik bedoel. de kolommen Y tot AT gebruik ik om op papier een nieuwe oplossing te zetten.
ik kan natuurlijk altijd de range aanpassen, maar ik heb een 15-tal tabbladen.

steven

 

[Roncancio]

For Each r In Range("A8").CurrentRegion
    If r.Value <> r.Offset(0, 1).Value Then r.Borders(xlEdgeRight).Weight = xlThin
    If r.Value <> r.Offset(1, 0).Value Then r.Borders(xlEdgeBottom).Weight = xlThin
Next

Bovenstaande code maakt de randen adhv de waardes die in de cellen staan.
Dat je gebruik maakt van meerdere werkbladen, kan in de macro rekening mee worden gehouden.

Met vriendelijke groet,


Roncancio

 

[snb]

Sub snb()
    Set sq = Cells(100, 1)
    Set sp = Cells(100, 1)

    with Cells(1).Resize(40, 11)
       .Borders.LineStyle = xlNone
       sn = .value
    end with

    For j = 1 To (UBound(sn) - 1) * (UBound(sn, 2) - 1)
      x = (j - 1) \ (Ubound(sn,2)-1) + 1
      y = (j - 1) Mod (Ubound(sn,2)-1) + 1
      If sn(x, y) <> sn(x, y + 1) Then Set sq = Union(sq, Cells(x, y))
      If sn(x, y) <> sn(x + 1, y) Then Set sp = Union(sp, Cells(x, y))
    Next
  
    sq.Borders(10).LineStyle = 1
    sq.Borders(11).LineStyle = 1
  
    sp.Borders(9).LineStyle = 1
    sp.Borders(12).LineStyle = 1
End Sub

 

[arafy]

deze macro loopt goed voor de range A1:J34, maar mijn range loopt van A1 tot AT34. ik zie niet waar je de range definieert.

steven

 

[snb]

ik zie niet waar je de range definieert

Duik dan nog eerst eens grondig in je VBA handboek....