2012年12月23日日曜日

Excel罫線のオートフィルタの問題点

Excel VBA で描いた罫線で オートフィルタ を使ったとき。フィルタ結果の一部に「 本来表示されるべきではない罫線が表示される現象 」が発生していました。

なかなか解決策が見つからず、この対策としては「 フィルタ結果に対して罫線を再描画する 」といった、場当たり的な方法でやり繰りしていたのですが、ようやく解決策が見つかりました。



「 本来表示されるべきではない罫線、が表示される現象 」とは

ここで改めて、この現象の説明をしておきます。下の図は VBA で罫線を描いた表のオートフィルタ前の状態です。表中で LineColor 列の red 行のデータ red を赤い下罫線、 blue 行のデータ blue を青い下罫線で描いています。

つぎに、オートフィルタを使って LineColor 列の、 red を選択した場合のフィルタ結果が下図です。期待する正しい結果は、赤い下罫線だけの表示なのですが、この表示結果では関係のない所に青い罫線が表示されていたり、赤い罫線のはずの red の所が青い罫線になっており、フィルタ結果がみっともない状態です。

オートフィルタで LineColor 列の、 blue を選択した場合も同様です。


スタイル設定を調べたときにヒントが！

Excel VBA の HELP で、 Bordersオブジェクト を調べると、こんな説明になっています。

このことから下罫線を描く場合には、 Bordersオブジェクト に指定する XlBordersIndex クラス の定数から、 xlEdgeBottom を使って描いていました。

以前、「 スタイル設定をシートに出力する　VBA マクロ 」を作りました。このとき Stylesコレクション から取得した、 Bordersプロパティ の indexの値 は以下のものでした。

xlLeft, xlRight, xlTop, xlBottom, xlDiagonalDown, xlDiagonalUp

Excel VBA の HELP、 Stylesコレクション のサンプルコードにも xlTop が使われていました。

HELP の Itemプロパティ では、「 xlEdgeXXX 」を使うように書かれています。

さて、ここで疑問が湧き出します。上下左右の罫線にある、「 xlEdgeXXX 」と「 xlXXX 」の定数の違いは何なのでしょうか？



「 xlEdgeBottom 」と「 xlBottom 」を比較してみる

両者の違いを探るため、比較用の VBA マクロを作り調べてみました。（この VBA マクロは文末に記載しています。）

テスト環境は、Excel 2003 SP3・Windows XP SP3 です。

下図左側の下罫線は「 xlEdgeBottom 」、下図右側の下罫線は「 xlBottom 」を使って描いています。その他は同一内容です。

オートフィルタで LineColor 列の、 red を選択したものです。下図右側の「 xlBottom 」の表示が良い感じです。

オートフィルタで LineColor 列の、 blue を選択。こちらの表示結果でも、下図右側の「 xlBottom 」で描いたほうは、正しくフィルタ表示できています。


オートフィルタでは「 xlBottom 」なら OK なの？

そこで、他のバージョンの Excel でも大丈夫なのか調べてみました。

他に使用できる Excel は、

  • Excel 2000 SP3
  • Excel 2010 評価版 (Office Professional 2010 Trial)
  • Excel 2013 Preview (Microsoft Office Professional 2013 Preview)
の 3 種類です。

まずはじめに Excel 2000 SP3・Windows XP SP3 から試してみました。

オートフィルタ項目 red

オートフィルタ項目 blue


つづいて、Excel 2010 評価版・Windows 7 Enterprise 評価版です。

オートフィルタ項目 red

オートフィルタ項目 blue


最後は Excel 2013 Preview・Windows 8 Release Previewです。

オートフィルタ項目 red

オートフィルタ項目 blue


結論、オートフィルタでは「 xlBottom 」を使えば OK

下罫線に「 xlBottom 」を使ったほうでは、いずれの結果もうまく動作しています。これでオートフィルタには「 xlBottom 」を使うことで正しく表示できることがわかりました。

今回調査した結果と、 Web で調べた結果から xlEdgeXXX と xlXXX の違いについて纏めてみると。（内容には未確認部分も含んでいます。）

  • ひとつのセルの上・下・左・右の罫線指定には、それぞれ 「 xlTop 」, 「 xlBottom 」, 「 xlLeft 」, 「 xlRight 」の定数を使う。
  • セル範囲（外周）の上・下・左・右の罫線指定には、それぞれ 「 xlEdgeTop 」, 「 xlEdgeBottom 」, 「 xlEdgeLeft 」, 「 xlEdgeRight 」 の定数を使う。

オートフィルタを使わなければ、どちらの方法で描いても大して変わらないのですが、オートフィルタを使うと挙動が違ってくるという訳です。これがオートフィルタの仕様なのか、バグなのか良く判りませんが、今まで懸案だった問題が少しスッキリした感じです。

今回の調査に使った VBA マクロを以下に記載します

Option Explicit
'/////  罫線のオートフィルタ動作テスト、メイン  /////
Sub Test_Borders()
    Dim mysheet As Worksheet
    Dim rTable_tmp As Range, rTable_left As Range, rTable_right As Range
    Dim xVal As Long
    Const xTable_Width As Integer = 6
    Const xTable_Height As Integer = 19
    Dim sTable_tmp As Variant

On Error GoTo ERR
    '表示データセット
    sTable_tmp = Array(Array("LineColor", "    ", "    ", "    ", "    ", "    "), _
                            Array("red ", "red ", "red ", "    ", "    ", "    "), _
                            Array("blue", "    ", "    ", "    ", "blue", "blue"), _
                            Array("red ", "    ", "red ", "red ", "    ", "    "), _
                            Array("blue", "    ", "    ", "blue", "blue", "    "), _
                            Array("red ", "    ", "    ", "red ", "red ", "    "), _
                            Array("red ", "    ", "    ", "    ", "red ", "red "), _
                            Array("blue", "    ", "blue", "blue", "    ", "    "), _
                            Array("blue", "blue", "blue", "    ", "    ", "    "), _
                            Array("red ", "red ", "red ", "red ", "    ", "    "), _
                            Array("red ", "    ", "red ", "red ", "red ", "    "), _
                            Array("red ", "    ", "    ", "red ", "red ", "red "), _
                            Array("blue", "blue", "blue", "blue", "    ", "    "), _
                            Array("blue", "    ", "blue", "blue", "blue", "    "), _
                            Array("blue", "    ", "    ", "blue", "blue", "blue"), _
                            Array("red ", "red ", "red ", "red ", "red ", "    "), _
                            Array("blue", "    ", "blue", "blue", "blue", "blue"), _
                            Array("red ", "    ", "red ", "red ", "red ", "red "), _
                            Array("blue", "blue", "blue", "blue", "blue", "    "))
    Set mysheet = ActiveSheet
    Set rTable_left = mysheet.Range("A2")
    Set rTable_right = mysheet.Range("H2")
    
    'オートフィルタ解除
    If mysheet.AutoFilterMode = True Then
        mysheet.AutoFilterMode = False
    End If
    
    '領域を消去
    Call DeleteTable(Range("A1:M20"))
    
    'テーブル作成　（失敗する罫線 xlEdgeBottom）
    rTable_left.Offset(-1, 0).Value = "失敗する罫線"
    Call Write_Table(rTable_left, sTable_tmp, xTable_Height, xTable_Width)
    xVal = xlEdgeBottom
    Set rTable_tmp = rTable_left.Offset(1, 1).Resize(xTable_Height - 1, xTable_Width - 1)
    Call Draw_Borders(rTable_tmp, xVal)
    
    'テーブル作成　（成功する罫線 xlBottom）
    rTable_right.Offset(-1, 0).Value = "成功する罫線"
    Call Write_Table(rTable_right, sTable_tmp, xTable_Height, xTable_Width)
    xVal = xlBottom
    Set rTable_tmp = rTable_right.Offset(1, 1).Resize(xTable_Height - 1, xTable_Width - 1)
    Call Draw_Borders(rTable_tmp, xVal)

    'オートフィルタ　オン
    If mysheet.AutoFilterMode = True Then
        mysheet.AutoFilterMode = False
    End If
    
    mysheet.Range("A2:M2").AutoFilter
    mysheet.Columns("A:M").AutoFit

ERR:
    Set rTable_right = Nothing
    Set rTable_left = Nothing
    Set rTable_tmp = Nothing
    Set mysheet = Nothing
End Sub
'/////  テーブルデータを表示  /////
Sub Write_Table(ByVal rTable_in As Range, ByVal sTable_in As Variant, nRow As Integer, nCol As Integer)
    Dim nCount As Integer, rTable As Range
    Set rTable = rTable_in.Resize(, nCol)
    
    For nCount = 0 To nRow - 1
        rTable.Offset(rowOffset:=nCount).Value = sTable_in(nCount)
    Next nCount

    Set rTable = Nothing
End Sub
'/////  テーブルに下罫線を描画  /////
Sub Draw_Borders(rTable As Range, xVal As Long)
    Dim r As Range

    '下罫線を描画
    For Each r In rTable
        With r.Borders(xVal)
            Select Case r.Text
            Case "red "
                .LineStyle = xlContinuous
                .Weight = xlThick
                .ColorIndex = 3
            Case "blue"
                .LineStyle = xlContinuous
                .Weight = xlThick
                .ColorIndex = 5
            Case Else
                .LineStyle = xlNone
            End Select
        End With
    Next r

    Set r = Nothing
End Sub

'/////  テーブルを消去  /////
Sub DeleteTable(rTable_range As Range)
    Dim r As Range
    rTable_range.Clear
    
    '下罫線を消去（消去は　xlEdgeBottom　を使う。）
    For Each r In rTable_range
        r.Borders(xlEdgeBottom).LineStyle = xlLineStyleNone
    Next r

    Set r = Nothing
End Sub
投稿者
ラベル:

0 件のコメント :

コメントを投稿

登録: コメントの投稿 ( Atom )