エクセルのセルの塗り色も同期させたい

異なるシートのセルの値を参照しているのですが、セルの塗り色も参照するようにできるのでしょうか？

塗り色を参照したいセルは1,000以上あり、そのいずれも塗り色まで同期させたいです。

宜しくお願いいたします。

No.1 回答者： hana-hana3 回答日時： 2006/06/29 13:36

参照できるのは、値（結果）だけなので、書式（色等）の参照は不可能です。

No.2 回答者： ao777 回答日時： 2006/06/29 14:10

VBAなら簡単に出来ますよ。

No.3 回答者： chie65536 回答日時： 2006/06/29 14:52

残念ながら、VBAでも簡単にはいきません。

例えば、Sheet1のC4セルで「=Sheet2!A3」と参照式があった場合。

Sheet1のC4セルの塗り色は、Sheet2のC4セルの色ではなく、Sheet2のA3セルの色でなければなりません。

塗り色をコピーすべきタイミングは、参照元のSheet2のA3セルの値を変更した時と、参照している式を書き換えた時です。

値または式が変更された時に呼び出されるイベントでは「変更があったのはココです」と言う情報が渡されてイベントが発生します。

Sheet2のA3セルの値を変更した時は、変更イベントには「場所はＡ３」としか情報が渡されて来ないので、そこのセルがSheet1のC4セルから参照されてると言う事が判りません。つまり、ここではどうしようもありません。

次に、参照している式を書き換えた時ですが、変更イベントには式を入れられたセル位置が渡されて来ます。イベント処理の中で、そのセルの式を参照する事は可能ですが色々と問題が出ます。

最初の問題は、渡されて来るセル位置が１セルだけじゃない、と言う事。範囲指定してのコピーペーストや、セルの連続コピーをされると、複数のセルが「範囲」として渡されて来ます。

まあ、複数セルが範囲として引数に渡されて来た時は、引数の行数、列数を数えて、ループ処理をすれば済みます。

それよりも問題なのが、まず、式が「"=Sheet2!A3"」のように「文字列として参照される」ので、自分で文字列を解析して「シートの場所は"Sheet2"で、セルの位置は"A3"だな」と言うのを拾い出さないとなりません。

もし、式に「=Sheet2!A3 + 10」とか「="単価" & Sheet2!A3 & "円"」なんてのが入っていたら、解析はとんでもなく難しくなります。

式に「=Sheet2!A3 + Sheet2!B6」とか入っていたら、どっちの色にすればいいのか。

式に「=SUM(Sheet2!A3:B6)」って入っていたら、どのセルの色にすれば…。

しかも、セル位置の指定が「A3」とか「B6」だけとは限りません。「$A$3」もあれば「$A3」もあれば「A$3」もあります。

で、それら参照先のシートとセル位置がセル１つごとにちゃんと拾い出せて、そこで初めて背景の塗り色をコピーして来る事ができます。

不可能ではないですが、とんでもなく難しいコーディングが必要になるでしょう。

No.4 回答者： zap35 回答日時： 2006/06/29 15:35

参照先のセルの色をコピーするマクロを作成しました。

動作の条件は単純に「=Sheet名!セルアドレス」となっていることです。

だから１００％期待通りには動かないかもしれません。（その時はご自身でＶＢＡを書き換えてみてください）

計算式が入ったり（例　= Sheet2!A3 + 10）、複数範囲を参照したり（例 = Sum(a1:e1) ）のときは色なしに戻します。
　　
Private Sub Worksheet_Change(ByVal Target As Range)
' 参照セル色流用
Dim tgCell, clFormula As Range, pos As Long
Dim wkText, wkSheet, wkRange As String
On Error Resume Next
Application.ScreenUpdating = False
Set clFormula = Selection.SpecialCells(xlCellTypeFormulas, 1)
Target.Interior.ColorIndex = xlNone
If clFormula.Cells.Count > 0 Then
For Each tgCell In clFormula
wkText = tgCell.Formula
pos = InStr(wkText, "!")
If pos > 0 Then
wkSheet = Mid(wkText, 2, pos - 2)
wkRange = Right(wkText, Len(wkText) - pos)
tgCell.Interior.ColorIndex = xlNone
tgCell.Interior.ColorIndex = Worksheets(wkSheet) _
.Range(wkRange).Interior.ColorIndex
End If
Next
End If
Application.ScreenUpdating = True
End Sub

なお参照セルがあまりにも多いときは、値入力時の反応が鈍くなるのでご注意ください

No.5 回答者： zap35 回答日時： 2006/06/29 15:58

＃０４です。

一箇所訂正がありました

Set clFormula = Selection.SpecialCells(xlCellTypeFormulas, 1)

は

Set clFormula = Selection.SpecialCells(xlCellTypeFormulas, 23)

にしてください。お手数をおかけします。

No.6 回答者： KenKen_SP 回答日時： 2006/06/29 18:27

こんにちは。

KenKen_SP です。

面白そうなので作ってみました。完全同期は、無理だと思います。
単純なリンクセルしか判定してないですけど、ご参考までに。


' ------------ 標準モジュール --------------------------------------

' API 部分はオマケですね、、

Public Declare Function GetKeyboardState Lib "user32" ( _
　　pbKeyState As Byte _
) As Long

Public Const VK_SHIFT = &H10　　'Shift
Public Const VK_CONTROL = &H11　'Ctrl
Public Const VK_MENU = &H12　　 'Alt

’メインです。オマケで右クリックに割り当ててますが、別にツールバーの
’ボタンでも構いません。
' 引数：着色　True リンクセルに着色します False リンクセルの色を消去

Public Sub リンクセル背景色(ByVal 着色 As Boolean)

　　Dim rngCell　　 As Range
　　Dim rngRefer　　As Range
　　Dim rngHasFormula As Range
　
　　Const ALL_TYPE = xlErrors Or xlLogical Or xlNumbers Or xlTextValues

　　On Error Resume Next
　　Set rngHasFormula = _
　　　　ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, ALL_TYPE)
　　For Each rngCell In rngHasFormula
　　　　Set rngRefer = Evaluate(rngCell.Formula)
　　　　If Not rngRefer Is Nothing Then
　　　　　　If 着色 Then
　　　　　　　　rngCell.Interior.Color = rngRefer.Interior.Color
　　　　　　Else
　　　　　　　　rngCell.Interior.ColorIndex = xlNone
　　　　　　End If
　　　　　　Set rngRefer = Nothing
　　　　End If
　　Next rngCell
　　Set HasFormula = Nothing

End Sub

'-------- 以下シートモジュール ---------------------------------

' 以下はオマケです。ショートカットキーみたいなものです。
' このコードを貼り付けたシートでは [Ctrl]、[Shift]、右クリックの
' 組み合わせでマクロが動作します。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

　　Dim KeyState(255) As Byte
　　Call GetKeyboardState(KeyState(0))
　　If CBool(KeyState(VK_SHIFT) And &H80) And _
　　　 CBool(KeyState(VK_CONTROL) And &H80) Then
　　　　' [Shift]+[Ctrl] + 右クリック時 -->色を消去
　　　　Call リンクセル背景色(False)
　　　　Cancel = True
　　ElseIf CBool(KeyState(VK_CONTROL) And &H80) Then
　　　　' [Ctrl] + 右クリック時　--＞着色
　　　　Call リンクセル背景色(True)
　　　　Cancel = True
　　End If

End Sub

No.7 回答者： moon00 回答日時： 2006/06/30 09:55

今まで出されている回答から、VBAでも難しいようなので、

「図のリンク貼り付け」で該当セルを必要なところに貼り付け、
実際の値は貼り付けたセルに参照させる方法はどうでしょうか。
見た目は参照セルそのまま、計算に用いるときは、セルに参照値が入っていると言う状態になります。
（既に1000以上のセルが参照されている状態なら、あまり現実味がないですが）

置き換える作業がVBAでできればもう少し楽になるかも。