Flytte farvede celler og optællingsceller

http://pmexcelent.dk/Farver.xls

Lige en løsning for mig. Enkelt og overskueligt.
Et svar..

ok velbekom
hvis du har spørgsmål til filen, siger du bare til.

Ved ikke om jeg kan være bekendt at spørge ind til hvordan ville det se ud hvis man kunne få tilfældigt 5, 10, 15, 20 eller 25 celler farvet med rammer om samme antal celler?
altså:
(f16:j16) farvet med rammer (altså ialt 5 celler)
(f15:j16) farvet med rammer (altså ialt 10 celler)
(f14:j16) farvet med rammer (altså ialt 15 celler)
(f13:j16) farvet med rammer (altså ialt 20 celler)
(f12:j16) farvet med rammer (altså ialt 5 celler)
...måske er det bare en lille ændring?

Hej Lund:
jeg er ikke sikker på hvad du mener.
kan du uddybe

Jeg tænker på om man kan lave en ændring således at det ikke altid er 25 celler jeg farver.
Ved hjælp af randomize kunne jeg vel tilfældigt farve 5, eller 10, eller 15, eller 20 eller 25 celler med rammer.
... altså eksempelvis
(f16:j16) farvet med rammer (altså ialt 5 celler. Dette er jo 1 række.

nåe ok så er jeg med :-)
kikker på det og vender tilbage hvis jeg finder en løsning

udskift Sub TilfældigFarve() med denne (ikke Functionen)

Sub TilfældigFarve()

Application.ScreenUpdating = False
Range("f12:j16").Clear

Randomize
x = Int(Rnd() * 5 + 1)

For r = 1 To x
For k = 1 To 5
Sheets("Fasit").Cells(r + 11, k + 5).Interior.ColorIndex = Int(Rnd() * 4 + 3)
Next
Next

'--- Slet eller Remark koden herunder hvis du foretrækker at anvende Functionen -------------------
Sheets("Fasit").Range("AB12:AB15") = ""
For Each c In Sheets("Fasit").Range("F12:J16")
If c.Interior.ColorIndex = 3 Then Sheets("Fasit").Range("AB12") = Sheets("Fasit").Range("AB12") + 1
If c.Interior.ColorIndex = 4 Then Sheets("Fasit").Range("AB13") = Sheets("Fasit").Range("AB13") + 1
If c.Interior.ColorIndex = 5 Then Sheets("Fasit").Range("AB14") = Sheets("Fasit").Range("AB14") + 1
If c.Interior.ColorIndex = 6 Then Sheets("Fasit").Range("AB15") = Sheets("Fasit").Range("AB15") + 1
Next
'------ slet her til -------------------------------------------------------------------------------

Sheets("Fasit").Range("F12:J" & x + 11).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  With Selection.Borders(xlEdgeLeft)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  With Selection.Borders(xlEdgeTop)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  With Selection.Borders(xlEdgeBottom)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  With Selection.Borders(xlEdgeRight)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  With Selection.Borders(xlInsideVertical)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
If x = 1 Then GoTo om
  With Selection.Borders(xlInsideHorizontal)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  Range("A1").Select
GoTo slut
om:
    Range("F13:J13").Select
    Selection.Clear
    Range("F12:J12").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A1").Select
slut:
Sheets("Fasit").Range("F12:J16").Copy Sheets("Opgaver").Range("F12")
Sheets("Fasit").Range("AF12").Calculate
Application.ScreenUpdating = True

End Sub

Genialt. Tusind Tak!
Så kan man da ikke ønske mere

ok velbekom :-)

Hej lunddata og excelent
Jeg har på et tidspunkt rodet lidt med en "pinkode husker" ala bankens bare elektronisk. Der bøvlede jeg med lidt af det samme (farvevede celler i forskellige størelse områder.
Er det muligt at få en kopi af jeres endelige løsning på dette spørgsmål?

Du kan anvende koden i min fil
den er frit tilgængelig for alle

mht. den færdige, så er det Lund du skal tale med

Hvis du kan bruge filen må du da gerne hente den på:
http://www.data.lundgraasten.dk/Farveceller.xls
.. dette er til meget simpel træning i optælling.
Jeg har efterfølgende i andre ark brugt farverne til at angive farvernes andel som brøker og som procenter. Det er altsammen til undervisningsbrug.

Du skal nok først selv hente og gemme filen for at koderne virker, sådan er det hos mig

Takker! sagde manden, da han sattte sig på en rive. :-)