Skocz do zawartości


Close Open
Close Open
Zdjęcie
- - - - -

[Excel] Kolorowanie komórek w arkuszach


  • Please log in to reply
8 replies to this topic

#1 god1985

god1985

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 02 luty 2007 - 19:17

Witam,

Mam problem z Excelem, a raczej ze zrobieniem następującej rzeczy.
Mamy w pracy grafiki z czasem pracy i listy obecności. Na grafiku jest np. 5 osób więc jest również potrzebnych 5 list obecności. Grafik w Excelu znajduje się w 'Arkusz1' natomiast listy obecności w 'Arkusz2', 'Arkusz3', ... , 'Arkusz5'. I chcę zrobić tak, że jak w 'Arkusz1' (na grafiku czasu pracy) zaznaczę tło komórek (np. A1:B5) np. sobót i niedziel na jakiś kolor to i na 'Arkusz2', 'Arkusz3', ... , 'Arkusz5' (na listach obecności) tło komórek (np. D1:E10) zanaczy się na ten sam kolor.

Czy jest możliwość zrobienia czegoś takiego? Jeśli tak to w jaki sposób?

#2 ryba191

ryba191

    Bywalec

  • Forumowicze
  • PipPipPipPipPip
  • 346 Postów:

Napisany 03 luty 2007 - 12:17

Witam.
Możliwość oczywiście jest - poprzez makra, wyprobuj taki kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:B5")) Is Nothing Then Arkusz2.Range("D1:E10").Interior.ColorIndex = Target.Interior.ColorIndex
End Sub

i dostosuj do wlasnych potrzeb.

Pozdrawiam

#3 god1985

god1985

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 07 luty 2007 - 07:29

Dziękuję bardzo za pomoc!!! :)

Działa tak jak chciałem...

#4 jotgie

jotgie

    Entuzjasta

  • Forumowicze
  • PipPipPipPipPipPipPip
  • 3700 Postów:

Napisany 07 luty 2007 - 08:13

... a szybsza i prostsza metoda to zaznaczenie z CTRL wszystkich arkuszy (za dole na zakładkach) i wówczas wszelkie formatowania w pierwszym arkuszu będą dotyczyć także wszystkich następnych zaznaczonych (jak i wpisy, formuły, itd).
Oczywiście w tych samych adresach, więc arkusze muszą być identyczne.
Wiec sformatowanie na czerwono komórki A1 w arkuszu1 zaznaczy także na czerwono komórkę A1 w arkuszach 2, 3, 4 i 5-tym.

Mało kto o tym wie... :)
Dodaj obrazek

#5 god1985

god1985

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 12 luty 2007 - 17:56

Oki tak jak już pisałem wszystko działa i jest OK, ale mam teraz jeden problem!!! Muszę to zrobić na 25 arkuszach i na każdym z nich w 31 zakresach komórek. Więc kod wygląda tak:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("C3:C29")) Is Nothing Then Arkusz2.Range("B9:L9").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("D3:D29")) Is Nothing Then Arkusz2.Range("B10:L10").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("E3:E29")) Is Nothing Then Arkusz2.Range("B11:L11").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("F3:F29")) Is Nothing Then Arkusz2.Range("B12:L12").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("G3:G29")) Is Nothing Then Arkusz2.Range("B13:L13").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("H3:H29")) Is Nothing Then Arkusz2.Range("B14:L14").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("I3:I29")) Is Nothing Then Arkusz2.Range("B15:L15").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("J3:J29")) Is Nothing Then Arkusz2.Range("B16:L16").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("K3:K29")) Is Nothing Then Arkusz2.Range("B17:L17").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("L3:L29")) Is Nothing Then Arkusz2.Range("B18:L18").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("M3:M29")) Is Nothing Then Arkusz2.Range("B19:L19").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("N3:N29")) Is Nothing Then Arkusz2.Range("B20:L20").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("O3:O29")) Is Nothing Then Arkusz2.Range("B21:L21").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("P3:P29")) Is Nothing Then Arkusz2.Range("B22:L22").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("Q3:Q29")) Is Nothing Then Arkusz2.Range("B23:L23").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("R3:R29")) Is Nothing Then Arkusz2.Range("B24:L24").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("S3:S29")) Is Nothing Then Arkusz2.Range("B25:L25").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("T3:T29")) Is Nothing Then Arkusz2.Range("B26:L26").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("U3:U29")) Is Nothing Then Arkusz2.Range("B27:L27").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("V3:V29")) Is Nothing Then Arkusz2.Range("B28:L28").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("W3:W29")) Is Nothing Then Arkusz2.Range("B29:L29").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("X3:X29")) Is Nothing Then Arkusz2.Range("B30:L30").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("Y3:Y29")) Is Nothing Then Arkusz2.Range("B31:L31").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("Z3:Z29")) Is Nothing Then Arkusz2.Range("B32:L32").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AA3:AA29")) Is Nothing Then Arkusz2.Range("B33:L33").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AB3:AB29")) Is Nothing Then Arkusz2.Range("B34:L34").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AC3:AC29")) Is Nothing Then Arkusz2.Range("B35:L35").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AD3:AD29")) Is Nothing Then Arkusz2.Range("B36:L36").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AE3:AE29")) Is Nothing Then Arkusz2.Range("B37:L37").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AF3:AF29")) Is Nothing Then Arkusz2.Range("B38:L38").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AG3:AG29")) Is Nothing Then Arkusz2.Range("B39:L39").Interior.ColorIndex = Target.Interior.ColorIndex

. . . . . . 

If Not Intersect(Target, Range("C3:C29")) Is Nothing Then Arkusz25.Range("B9:L9").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("D3:D29")) Is Nothing Then Arkusz25.Range("B10:L10").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("E3:E29")) Is Nothing Then Arkusz25.Range("B11:L11").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("F3:F29")) Is Nothing Then Arkusz25.Range("B12:L12").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("G3:G29")) Is Nothing Then Arkusz25.Range("B13:L13").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("H3:H29")) Is Nothing Then Arkusz25.Range("B14:L14").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("I3:I29")) Is Nothing Then Arkusz25.Range("B15:L15").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("J3:J29")) Is Nothing Then Arkusz25.Range("B16:L16").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("K3:K29")) Is Nothing Then Arkusz25.Range("B17:L17").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("L3:L29")) Is Nothing Then Arkusz25.Range("B18:L18").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("M3:M29")) Is Nothing Then Arkusz25.Range("B19:L19").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("N3:N29")) Is Nothing Then Arkusz25.Range("B20:L20").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("O3:O29")) Is Nothing Then Arkusz25.Range("B21:L21").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("P3:P29")) Is Nothing Then Arkusz25.Range("B22:L22").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("Q3:Q29")) Is Nothing Then Arkusz25.Range("B23:L23").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("R3:R29")) Is Nothing Then Arkusz25.Range("B24:L24").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("S3:S29")) Is Nothing Then Arkusz25.Range("B25:L25").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("T3:T29")) Is Nothing Then Arkusz25.Range("B26:L26").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("U3:U29")) Is Nothing Then Arkusz25.Range("B27:L27").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("V3:V29")) Is Nothing Then Arkusz25.Range("B28:L28").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("W3:W29")) Is Nothing Then Arkusz25.Range("B29:L29").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("X3:X29")) Is Nothing Then Arkusz25.Range("B30:L30").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("Y3:Y29")) Is Nothing Then Arkusz25.Range("B31:L31").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("Z3:Z29")) Is Nothing Then Arkusz25.Range("B32:L32").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AA3:AA29")) Is Nothing Then Arkusz25.Range("B33:L33").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AB3:AB29")) Is Nothing Then Arkusz25.Range("B34:L34").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AC3:AC29")) Is Nothing Then Arkusz25.Range("B35:L35").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AD3:AD29")) Is Nothing Then Arkusz25.Range("B36:L36").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AE3:AE29")) Is Nothing Then Arkusz25.Range("B37:L37").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AF3:AF29")) Is Nothing Then Arkusz25.Range("B38:L38").Interior.ColorIndex = Target.Interior.ColorIndex
If Not Intersect(Target, Range("AG3:AG29")) Is Nothing Then Arkusz25.Range("B39:L39").Interior.ColorIndex = Target.Interior.ColorIndex

End Sub

Przy czym VisualBasic wypisuje, że kod jest za długi... Czy da się go jakoś skrócić?

#6 Zeja__

Zeja__

    Początkujący

  • Forumowicze
  • PipPipPip
  • 98 Postów:

Napisany 12 luty 2007 - 21:04

Przy czym VisualBasic wypisuje, że kod jest za długi... Czy da się go jakoś skrócić?

<{POST_SNAPBACK}>

O GOD ! :o
ale się napracowałeś ;)
spróbuj potraktować Arkusz a raczej jego nazwę jako zmienną np.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim NazwaArkusza As String
Dim nr As Long
Dim zmiana As Integer
nr = 1
W1:
'i ten zapis If nr = 4 Then GoTo W2 kończy makro w miejsce 4 musisz wpisać nr. ostatniego Arkusza
If nr = 4 Then GoTo W2
nr = nr + 1

NazwaArkusza = "Arkusz" & nr

If Not Intersect(Target, Range("C3:C29")) Is Nothing Then Worksheets(NazwaArkusza).Range("B9:L9").Interior.ColorIndex = Target.Interior.ColorIndex

If Not Intersect(Target, Range("D3:D29")) Is Nothing Then Worksheets(NazwaArkusza).Range("B10:L10").Interior.ColorIndex = Target.Interior.ColorIndex

'itd..
'...
'' wszystkie dotyczące Arkusza 2
' znów zapis ograniczający czyli ta "4" zamień na ostani nr. Arkusza
If nr < 4 Then GoTo W1
W2:
End Sub

wiem że zaraz mnie ktoś op..niczy za skoki GoTo ale jakoś tak mi było wygodniej :blush:

#7 Zeja__

Zeja__

    Początkujący

  • Forumowicze
  • PipPipPip
  • 98 Postów:

Napisany 12 luty 2007 - 21:13

Aha !
musisz mieć tyle Arkuszy ile wpiszesz w makrze !!
ten kod nie utworzy Arkusza :(

#8 gilbert_z

gilbert_z

    Uczestnik

  • Forumowicze
  • PipPipPipPip
  • 152 Postów:

Napisany 12 luty 2007 - 22:50

Proponuje raczej zastosować pętlę For...Each. Działa na tylu arkuszach ile ich jest bez konieczności ich liczenia.
Kod będzie wyglądał tak:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Wks As Worksheet
Dim Arkusz

For Each Arkusz In Sheets
  If ActiveSheet.Name <> Arkusz.Name Then
    Set Wks = Arkusz
    'tutaj dajesz swoje IFy tyle tylko, że zamiast pisać Arkusz2, Arkusz3, Arkusz100 piszesz poprostu Arkusz
    '....
    '....
  End If
Next

End Sub
Chyba powinno działać
G

#9 god1985

god1985

    Adept

  • Forumowicze
  • Pip
  • 8 Postów:

Napisany 13 luty 2007 - 18:08

Zeja__ dzięki za pomoc!!! :) Masz u mnie dużego "+"




0 Użytkowników czyta ten temat

0 użytkowników, 0 gości, 0 anonimowych użytkowników