[[20100721134421]] 『条件付書式を通常書式に一括変換』(Coonie) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『条件付書式を通常書式に一括変換』(Coonie)
 条件式書式を使用してセルを色づけしているのですが、これを通常書式に一括変更する方法はないでしょうか?
 後から他の人が色を変えられるように書式編集を可能にしたいのですが、その度に条件付書式を解除してもらうのは大変な手間です。
 変換が難しいなら、通常書式設定を条件付書式設定より優先させられれば事は足りるのですが。。。
 使用環境:Excel2002/WindowsXP


 >これを通常書式に一括変更する方法はないでしょうか?
 どういったことが望みなのかわかりませんが、セル範囲を選択して、
 条件付書式の削除をしたらいいと思いますけど??
 BJ

 望みとしては、条件付書式でつけた色を残したまま、通常書式設定での編集(色の変更)を可能にしたいのです。
(Coonie)


 条件付書式。
 条件によってセルの色が変わるとかなるようにする。
 条件付書式が設定されていれば、条件によって色が変わるのが当たり前。
 条件付書式が無くなればデフォルトに戻るように作られている。
 これらを考えて、出来ることとできないことを自分で判断することも大切。
 BJ


 条件付書式を設定したままだと指定した条件と競合する編集は不可なので、
 通常書式の設定として変換できないかな、というのが質問でした。

 例えばセルの計算式で出した数字は、値としてセルに貼り付ければ
 計算の元となったセルの値(条件)に左右されなくなる。
 そんなことが書式設定でも出来たらな〜、と。
 無いという事ですよね。ありがとうございました。
(Coonie)

 > 例えばセルの計算式で出した数字は、値としてセルに貼り付ければ
 > 計算の元となったセルの値(条件)に左右されなくなる。
 > そんなことが書式設定でも出来たらな〜、と。

 そう云うことでしたら、通常書式をセルに直接設定しないで、
  どこかのセル範囲に通常書式のサンプルを幾つか作って置き、
  そこから希望の書式のセルを選択してから、
  書式コピー→条件付き書式が設定されているセルに(書式の)貼り付け
 でどうでしょうか?

 書式の丸ごと入れ替えですから、以前の書式は一切なくなります。(と思う)

  (半平太) 2010/07/21 15:48

 >半平太さま
 書式貼付は条件を削除してもらうよりは簡単そうです。
 アイデア、ありがとうございます!

 対象となるセルが膨大なので、セルを範囲指定して
 「現在の書式を通常書式として貼付」みたいな事が出来れば、
 という期待があったのですが、多くを望んではいけませんね。

 BJさま、半平太さま、ありがとうございました。
(Coonie)

もう遅いかもしれませんが、色づけをVBAでやるという手もあります。
VBA書く必要がありますが、VBAコード次第で条件書式設定のタイミングや範囲を任意に作れます。

条件付書式の設定値が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


2chじゃないんだから、良識ぐらい持とうよ・・・

unkown


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.