[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『条件付書式を通常書式に一括変換』(Coonie)
条件式書式を使用してセルを色づけしているのですが、これを通常書式に一括変更する方法はないでしょうか? 後から他の人が色を変えられるように書式編集を可能にしたいのですが、その度に条件付書式を解除してもらうのは大変な手間です。 変換が難しいなら、通常書式設定を条件付書式設定より優先させられれば事は足りるのですが。。。 使用環境:Excel2002/WindowsXP
>これを通常書式に一括変更する方法はないでしょうか? どういったことが望みなのかわかりませんが、セル範囲を選択して、 条件付書式の削除をしたらいいと思いますけど?? BJ
望みとしては、条件付書式でつけた色を残したまま、通常書式設定での編集(色の変更)を可能にしたいのです。 (Coonie)
条件付書式。 条件によってセルの色が変わるとかなるようにする。 条件付書式が設定されていれば、条件によって色が変わるのが当たり前。 条件付書式が無くなればデフォルトに戻るように作られている。 これらを考えて、出来ることとできないことを自分で判断することも大切。 BJ
条件付書式を設定したままだと指定した条件と競合する編集は不可なので、 通常書式の設定として変換できないかな、というのが質問でした。
例えばセルの計算式で出した数字は、値としてセルに貼り付ければ 計算の元となったセルの値(条件)に左右されなくなる。 そんなことが書式設定でも出来たらな〜、と。 無いという事ですよね。ありがとうございました。 (Coonie)
> 例えばセルの計算式で出した数字は、値としてセルに貼り付ければ > 計算の元となったセルの値(条件)に左右されなくなる。 > そんなことが書式設定でも出来たらな〜、と。
そう云うことでしたら、通常書式をセルに直接設定しないで、 どこかのセル範囲に通常書式のサンプルを幾つか作って置き、 そこから希望の書式のセルを選択してから、 書式コピー→条件付き書式が設定されているセルに(書式の)貼り付け でどうでしょうか?
書式の丸ごと入れ替えですから、以前の書式は一切なくなります。(と思う)
(半平太) 2010/07/21 15:48
>半平太さま 書式貼付は条件を削除してもらうよりは簡単そうです。 アイデア、ありがとうございます!
対象となるセルが膨大なので、セルを範囲指定して 「現在の書式を通常書式として貼付」みたいな事が出来れば、 という期待があったのですが、多くを望んではいけませんね。
BJさま、半平太さま、ありがとうございました。 (Coonie)
条件付書式の設定値がVBAから参照できれば条件付書式を通常書式に変換する事もできるはずですが、どうも条件付書式はVBAからはブラックボックスのようです。
設定数上限が妙に少ない固定値であることから考えても、あまりマトモな経緯で実装された機能じゃないのかもしれません。
>これらを考えて、出来ることとできないことを自分で判断することも大切。
素直に俺は思いつけませんでしたって言えよ・・・人の所為にしないでさ。
解決策すら無い人が全レスしても意味が無いと思う。
(通りすがり)2010/08/22 11:17
>どうも条件付書式はVBAからはブラックボックスのようです。 新規ブックにて試してみてください。
標準モジュールに
'============================================================
Option Explicit
Sub mk_sample()
With Range("a1:a13")
.FormatConditions.Delete
With .Cells(1)
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="15"
.FormatConditions(1).Interior.ColorIndex = 3
.Value = 15
End With
With .Cells(3)
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="1"
.FormatConditions(1).Font.ColorIndex = 3
With .FormatConditions(1).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .FormatConditions(1).Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Value = 1
End With
With .Cells(5)
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="=""x""", Formula2:="=""z"""
.FormatConditions(1).Font.ColorIndex = 5
.Value = "Y"
End With
With .Cells(7)
.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
Formula1:="=""a""", Formula2:="=""g"""
.FormatConditions(1).Interior.ColorIndex = 7
.Value = "p"
End With
With .Cells(9)
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="20"
.FormatConditions(1).Font.ColorIndex = 3
With .FormatConditions(1).Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With .FormatConditions(1).Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With .FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
With .FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
.Value = True
End With
With .Cells(11)
.Select
.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="20"
.FormatConditions(1).Interior.ColorIndex = 39
.Value = 19
End With
With .Cells(13)
.Select
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=OR(A13=""A"",A13=""b"",A13=""C"")"
With .FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
With .FormatConditions(1).Interior
.ColorIndex = 8
.PatternColorIndex = 3
.Pattern = xlGray8
End With
.Value = "b"
End With
End With
End Sub
上記、mk_sample を実行してみてください。
アクティブシートのセルA1:A13の奇数行セルに条件付書式を設定し、条件に合う値を 設定するコードです。 それぞれ違う条件を設定してありますから、詳細は、条件付書式のダイアログにて、 確認してみてください。
この条件付書式にて、表示されている書式を実際の書式に移行し、条件付書式を削除するコードを考えます。
別の標準モジュールに
'=================================================================
Sub 条件付書式の書式移行()
Dim rng As Range
Dim g0 As Long
Dim crng As Range
Set rng = Selection
For Each crng In rng
With crng
.Activate
Call copyformat(.Cells(1))
.FormatConditions.Delete
End With
Next
End Sub
'===================================================================
Sub copyformat(ByVal rng As Range)
Dim bd As Variant
Dim g0 As Long
Dim g1 As Long
Dim g2 As Long
Dim bb As Border
Dim bdidx As Variant
Dim fo As Variant
Dim f1 As Variant
Dim f2 As Variant
Dim retcode As Long
bdidx = Array(7, 10, 8, 9)
bd = Array("Weight", "linestyle", "color")
fo = Array("FontStyle", "Bold", "Italic", "Strikethrough", "Underline")
With rng
For g0 = 1 To .FormatConditions.Count
retcode = 1
With .FormatConditions(g0)
If .Type = xlCellValue Then
Select Case .Operator
Case 1
f1 = Evaluate(.Formula1)
f2 = Evaluate(.Formula2)
If StrComp(rng.Value, f1, vbTextCompare) >= 0 And StrComp(rng.Value, f2, vbTextCompare) <= 0 Then
retcode = 0
End If
Case 2
f1 = Evaluate(.Formula1)
f2 = Evaluate(.Formula2)
If StrComp(rng.Value, f1, vbTextCompare) >= 0 And StrComp(rng.Value, f2, vbTextCompare) <= 0 Then
Else
retcode = 0
End If
Case 3
f1 = Evaluate(.Formula1)
If StrComp(rng.Value, f1, vbTextCompare) = 0 Then
retcode = 0
End If
Case 4
f1 = Evaluate(.Formula1)
If StrComp(rng.Value, f1, vbTextCompare) <> 0 Then
retcode = 0
End If
Case 5
f1 = Evaluate(.Formula1)
If StrComp(rng.Value, f1, vbTextCompare) > 0 Then
retcode = 0
End If
Case 6
f1 = Evaluate(.Formula1)
If StrComp(rng.Value, f1, vbTextCompare) < 0 Then
retcode = 0
End If
Case 7
f1 = Evaluate(.Formula1)
If StrComp(rng.Value, f1, vbTextCompare) >= 0 Then
retcode = 0
End If
Case 8
f1 = Evaluate(.Formula1)
If StrComp(rng.Value, f1, vbTextCompare) <= 0 Then
retcode = 0
End If
End Select
Else
If Evaluate(.Formula1) Then retcode = 0
End If
If retcode = 0 Then
On Error Resume Next
If Not IsNull(.Interior.Pattern) Then
rng.Interior.Pattern = .Interior.Pattern
rng.Interior.PatternColorIndex = .Interior.PatternColorIndex
End If
If Not IsNull(.Interior.ColorIndex) Then
rng.Interior.ColorIndex = .Interior.ColorIndex
rng.Interior.Color = .Interior.Color
End If
If Not IsNull(.Font.ColorIndex) Then
rng.Font.Color = .Font.Color
rng.Font.ColorIndex = .Font.ColorIndex
End If
For g1 = LBound(fo) To UBound(fo)
CallByName rng.Font, fo(g1), VbLet, CallByName(.Font, fo(g1), VbGet)
Next
For g1 = 1 To .Borders.Count
For g2 = LBound(bd) To UBound(bd)
If Not IsNull(CallByName(.Borders(g1), "Weight", VbGet)) Then
CallByName rng.Borders(bdidx(g1 - 1)), bd(g2), VbLet, CallByName(.Borders(g1), bd(g2), VbGet)
End If
Next
Next
On Error GoTo 0
End If
End With
Next
End With
End Sub
条件付書式を移行するセルA1:A13を選択し、この状態で 「条件付書式の書式移行」を実行してみてください。
実際の書式に移行し、条件付書式の設定は、削除されます。
これが、質問者さんの望んだ仕様か否かは、わかりませんが・・・。
試してみてください。Excel2002にて、簡単なテストはしました。
>>これらを考えて、出来ることとできないことを自分で判断することも大切。 >素直に俺は思いつけませんでしたって言えよ・・・ 回答者は、先生ではないですからね!! ちょっと、先に勉強している上級生か同級生といったところですよ!!
>>これらを考えて、出来ることとできないことを自分で判断することも大切。 これも技術論としての率直な意見ですよね? それをこんな乱暴な物言いをされてしまうと 良かれと思って投稿する方が 減ってしまいますよ!! 最低限の投稿マナーというのは、 質問者,回答者両方にあると思いますけどね!! ichinose@再訂正
>素直に俺は思いつけませんでしたって言えよ・ 最近、やたらとつっかってくるカスが多いな。 (最近でもないか。あ〜、うざってぇ。)
>色づけをVBAでやるという手もあります。 意味解んねぇ。 質問者は、条件付書式で、色をつけているといっているのに、話擂りかえるなよ。 また、色をつけなおしなさいってことかい。 マクロを書く気が無いのにねぇ。たいしたもんだ。
マクロを強要する気もないし、書く気も無かったし、マクロを知らない人に完成版の マクロコードを提供して、ここに質問すれば、マクロを作ってくれると思うような 質問者を育てたいとも思わないし、わざわざ遠まわしに質問すればマクロを作って くれると思うような質問者も育てたいとは思っていないので、色々と自分で試行錯誤 した結果、手動でできる事とできない事の判断と、言うか見切りも必要という事。 であれば、 マクロならどうだろうかとの質問に変わる場合がある。 もっともマクロを知っている必要があるけど。 今まで、いきなりマクロを提供して、数ヵ月後に作ってもらったマクロの修正等を 自力で解決させようとした人が何名いるのやら。 BJ
unkown
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.