Avatar billede evendorff Juniormester
28. juni 2021 - 11:18 Der er 13 kommentarer og
1 løsning

Cellen skal være RØD

For række 15 skal celler i hver anden kolonne fra S15 (S=19) til EG15 (EG=137) have rød fyldfave når cellen markeres med musen.

Mvh
Knud Evendorff
Avatar billede jens48 Ekspert
28. juni 2021 - 14:07 #1
Er dette noget der kan bruges?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("S15:EG15").Interior.ColorIndex = 0
If Not Intersect(Target, Range("S15:EG15")) Is Nothing Then
For x = 19 To 137
If Cells(15, x).Column / 2 = Int(Cells(15, x).Column / 2) Then
Cells(15, x).Interior.ColorIndex = 3
End If
Next
End If
End Sub
Avatar billede evendorff Juniormester
28. juni 2021 - 14:31 #2
Tak for svar. Jeg har sat din kode ind i arket. Den giver fejl (og ingen Rød fyld). Koden eksekveres også, når musen er på alle andre positioner.

Mvh
Knud Evendorff
Avatar billede jens48 Ekspert
28. juni 2021 - 15:19 #3
Det forstår jeg ikke. Koden aktiveres når der skiftes celle, og cellefarvningen forsvinder. Hvis der skiftes til en af cellerne i S15:EG15 farves hver anden celle i omådet S15:EG15 rødt
Avatar billede evendorff Juniormester
28. juni 2021 - 16:00 #4
Jeg glemte at fortælle at arket er arkbeskyttet men at cellerne S15 til EG15 er frie og ubeskyttet. Det giver fejl. For hvis jeg fjerner Arkbeskyttelsen, så er der ikke kodefejl.
Arket skal være beskyttet.

De relevante celler har farven mørk grøn RGB: 0;137;134.
Der sker dette:
Alle relevante celler bliver 'hvide' og mellemrum fra R15 og frem bliver røde.
Kun den celle (ud af de elevante) som clickes på, skal blive rød.
Avatar billede jens48 Ekspert
28. juni 2021 - 23:05 #5
Hvis du med “mellemrum” mener inaktive celler mellem de aktive tror jeg at jeg står af her. Det giver kun besvær, hvis man af hensyn til layout bruger ekstra celler mellem de aktive celler, og det ønsker jeg ikke at bruge tid på.
Avatar billede evendorff Juniormester
29. juni 2021 - 01:12 #6
Du misforstår opgaven. Kun den celle, der er bliver clicket på, skal have rød fyldfarve og kun indtil musen flyttes. Det skal gælde for cellerne (i række 15) S15, U15, W15 og indtil celle EG15. Dvs hver anden celle og 60 celler i alt.
Koden skal følge musens placering og reagere på ovennævnte celler med rød fyldfarve.
Avatar billede evendorff Juniormester
29. juni 2021 - 06:36 #7
For at blive helt konkret, så er det følgende 60 celler :
S15; U15; W15; Y15; AA15; AC15; AE15; AG15; AI15; AK15; AM15; AO15; AQ15; AS15; AU15; AW15; AY15; BA15; BC15; BE15; BG15; BI15; BK15; BM15; BO15; BQ15; BS15; BU15; BW15; BY15; CA15; CC15; CE15; CG15; CI15; CK15; CM15; CO15; CQ15; CS15; CU15; CW15; CY15; DA15; DC15; DE15; DG15; DI15; DK15; DM15; DO15; DQ15; DS15; DU15; DW15; DY15; EA15; EC15; EE15; EG15
som skal have rød fyld farve, når musen clicker og markerer cellen. Når musen forlader cellen, skal cellen have sin egen farve.
Avatar billede jens48 Ekspert
29. juni 2021 - 11:47 #8
OK, så kan dette måske bruges:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("S15:EG15")) Is Nothing Then
Worksheets("Sheet1").Unprotect
For x = 19 To 137 Step 2
If Target.Column = x Then
Cells(15, x).Interior.ColorIndex = 3
Else
Cells(15, x).Interior.Color = RGB(0, 137, 134)
End If
Next
Worksheets("Sheet1").Protect
End If
End Sub

Hvis det er med password, skal du lige rette to linjer:
Worksheets("Sheet1").Unprotect
og
Worksheets("Sheet1").Protect
til
Worksheets("Sheet1").Unprotect Password:="My Password"
Worksheets("Sheet1").Protect Password:="My Password"
Avatar billede evendorff Juniormester
29. juni 2021 - 14:15 #9
Tak,
Den giver fejl på
Worksheets("Sheet1").Unprotect

Skal jeg erstatte 'Sheet1' med arkets navn?

Koden er uden virkning uden for området, OK:

mvh
Knud Evedorff
Avatar billede evendorff Juniormester
29. juni 2021 - 14:43 #10
Jeg skrev : Koden er uden virkning uden for området, OK:
Men det er ikke helt rigtigt. Koden virker også i mellemrum, og det skal den jo ikke.
Men det går måske godt, hvis kører helt til ende, men farven er ikke grøn i mellemrum, men grå RBG (231,230;230).
Avatar billede evendorff Juniormester
29. juni 2021 - 15:18 #11
Jeg har lavet en hjælpe række 7 som tæller de valide kolonner op med 1 fra S=1, U=2 .. til EG=60. Mellemrum er 0.
Stadig kun gældende fra S til EG.
Kan du bruge det.
Avatar billede evendorff Juniormester
29. juni 2021 - 19:14 #12
Jeg har lavet en lille rettelse, og nu kører koden

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("S15:EG15")) Is Nothing Then
ActiveSheet.Unprotect
For x = 19 To 137 Step 2
If Target.Column = x Then
Cells(15, x).Interior.ColorIndex = 3
Else
Cells(15, x).Interior.Color = RGB(0, 137, 134)
End If
Next
ActiveSheet.Protect
End If
End Sub

Men, men hvis jeg flytter musen til en vilkårlig anden celle (som ikke er S15 til EG15). så er cellen stadig rød, og det skal den ikke være.
Avatar billede jens48 Ekspert
29. juni 2021 - 22:04 #13
Jeg har rettet den lidt til

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect
For x = 19 To 137 Step 2
Cells(15, x).Interior.Color = RGB(0, 137, 134)
Next
If Not Intersect(Target, Range("S15:EG15")) Is Nothing Then
For x = 19 To 137 Step 2
If Target.Column = x Then
Cells(15, x).Interior.ColorIndex = 3
Else
Cells(15, x).Interior.Color = RGB(0, 137, 134)
End If
Next
ActiveSheet.Protect
End If
End Sub
Avatar billede evendorff Juniormester
29. juni 2021 - 23:56 #14
Koden spiller 100%. Tusind tak endnu engang.
mvh
Knud Evendorff
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester