[[20121118092049]] 『マクロにて行列を非表示にしたい』(Masa) ページの最後に飛ぶ

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

 

『マクロにて行列を非表示にしたい』(Masa)
以下の様な表があります。
マクロにて数値データがすべて空欄の行と列を非表示にする方法を教えてください。
この表の場合D、G列目、3、5行目を非表示にしたいです。
データセルの範囲は先頭はB2固定ですが、G6はその都度変化します。
よろしくお願いします。

      A       B            C            D           E             F            G
1           11/18        11/19        11/20       11/21        11/22        11/23
2   あ      100            50                       10 
3   い 
4   う                     70                       20            60     
5   え 
6   お       60                                     40            90  

Excel2007
Windows7


 淡々と愚直に。

 Sub Sample()
    Dim r As Range
    Dim ar As Range
    Dim ac As Range
    With Range("A1").CurrentRegion
        With .Resize(.Rows.Count - 1, .Columns.Count - 1).Offset(1, 1)
            For Each r In .Columns
                If WorksheetFunction.CountA(r) > 0 Then
                    If ac Is Nothing Then
                        Set ac = r
                    Else
                        Set ac = Union(ac, r)
                    End If
                End If
            Next

            For Each r In .Rows
                If WorksheetFunction.CountA(r) > 0 Then
                    If ar Is Nothing Then
                        Set ar = r
                    Else
                        Set ar = Union(ar, r)
                    End If
                End If
            Next

            .EntireRow.Hidden = True
            .EntireColumn.Hidden = True

            If Not ac Is Nothing Then ac.EntireColumn.Hidden = False
            If Not ar Is Nothing Then ar.EntireRow.Hidden = False
        End With
    End With

 End Sub

 (ぶらっと)

 同じ愚直でも以下のほうが少しはおりこうさん?

 Sub Sample2()
    Dim r As Range
    Dim ar As Range
    Dim ac As Range
    With Range("A1").CurrentRegion
        With .Resize(.Rows.Count - 1, .Columns.Count - 1).Offset(1, 1)
            For Each r In .Columns
                If WorksheetFunction.CountA(r) = 0 Then
                    If ac Is Nothing Then
                        Set ac = r
                    Else
                        Set ac = Union(ac, r)
                    End If
                End If
            Next

            For Each r In .Rows
                If WorksheetFunction.CountA(r) = 0 Then
                    If ar Is Nothing Then
                        Set ar = r
                    Else
                        Set ar = Union(ar, r)
                    End If
                End If
            Next

            If Not ac Is Nothing Then ac.EntireColumn.Hidden = True
            If Not ar Is Nothing Then ar.EntireRow.Hidden = True

        End With
    End With

 End Sub

 (ぶらっと)

こんにちは

同じく数式「COUNTA」ですけど、セル上で、

 Sub test()
    With Range("A1").CurrentRegion
        With .Offset(0, .Columns.Count).Columns(1)
            .FormulaR1C1 = "=IF(COUNTA(RC1:RC[-1])=1,"""",1)"
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
            On Error GoTo 0
            .ClearContents
        End With
        With .Offset(.Rows.Count, 0).Rows(1)
            .FormulaR1C1 = "=IF(COUNTA(R1C:R[-1]C)=1,"""",1)"
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            On Error GoTo 0
            .ClearContents
        End With
    End With
End Sub
(ウッシ)

ぶらっとさん、ウッシさん 

回答ありがとうございます。

列の非表示は問題なくなるのですが、行はそのままで非表示にならないです。

実際の表はA列〜I列まで項目が入っていて、その項目に数値も含まれているからでしょうか?

(Masa)


こんにちは

行が非表示にならないという事はたまたま表示されている列のどこかに「0」が入ってオプション設定で
ゼロ値を表示しないようになっているとかではないですか?

もっといい数式が有りそうなんですけど、思いつかないので

 Sub test1()
    With Range("A1").CurrentRegion
        With .Offset(0, .Columns.Count).Columns(1)
            .FormulaR1C1 = "=IF(COUNTIF(RC1:RC[-1],0)+COUNTBLANK(RC1:RC[-1])=COLUMN()-2,"""",1)"
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
            On Error GoTo 0
            .ClearContents
        End With
        With .Offset(.Rows.Count, 0).Rows(1)
            .FormulaR1C1 = "=IF(COUNTIF(R1C:R[-1]C,0)+COUNTBLANK(R1C:R[-1]C)=ROW()-2,"""",1)"
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            On Error GoTo 0
            .ClearContents
        End With
    End With
End Sub
(ウッシ)

 ウッシさんの指摘のように 数値の 0 があって、それも空白とみなすなら、私のコードも、ちょっとインチキを。

 Sub Sample3()
    Dim r As Range
    Dim ar As Range
    Dim ac As Range
    Dim v As Variant

    With Range("A1").CurrentRegion
        v = .Formula
        .Value = .Value
        .Replace What:="0", LookAt:=xlWhole, Replacement:=""
        With .Resize(.Rows.Count - 1, .Columns.Count - 1).Offset(1, 1)
            For Each r In .Columns
                If WorksheetFunction.CountA(r) = 0 Then
                    If ac Is Nothing Then
                        Set ac = r
                    Else
                        Set ac = Union(ac, r)
                    End If
                End If
            Next

            For Each r In .Rows
                If WorksheetFunction.CountA(r) = 0 Then
                    If ar Is Nothing Then
                        Set ar = r
                    Else
                        Set ar = Union(ar, r)
                    End If
                End If
            Next

            If Not ac Is Nothing Then ac.EntireColumn.Hidden = True
            If Not ar Is Nothing Then ar.EntireRow.Hidden = True

        End With
        .Value = v
    End With

 End Sub

 (ぶらっと)

ウッシさん、ぶらっとさん、

すみませんが、同じ結果になります。行が非表示にならないです。
セルにはゼロは入力されていないです。

(Masa)


 その非表示にならない行、たとえばそれが 10行目だとしたら どこかのセルに =COUNTA(B10:○10) といれると
 結果はいくつになっている? (○ はリストの右端の列)

 (ぶらっと)

こんばんは
セルの結合はないですよね?
(ウッシ)

ぶらっとさん、ウッシさん、

結果は0(ゼロ)になります。また、セルの結合はないです。
ちなみに、J2のセルから右方向と下方向にデータが入っていて、
A列〜I列までは、文字or数値の固定値が入っています。

(Masa)


こんばんは

なんか良く分からないんですけど、

J2のセルから右方向と下方向にデータ、って、B2:J?がデータ範囲って事ですよね?
A列〜I列までは、文字or数値の固定値、I列?
最初の表例では、1行目は月日で、1列目は文字列でしたよね?

正確にどんな表でテストしてるのか教えて下さい。

(ウッシ)


 アップされた例ではリスト範囲はG列までなんだけど、そのリストとは別の何者かがH列以降にあるということ?
 G6は都度変化とあったので、リスト範囲がG列より右にも伸びるのかなぁと思ってたんだけど。
 また、J2から右と下にリストとは異なる何者かがある?

 ということで、リストがG列までと決まっているなら、とりあえず。
 (これでも、H列以降の列の状況で、正しく処理されない可能性もある。ウッシさんの指摘通り、レイアウトを正確に説明してほしいね)

 With Range("A1").CurrentRegion

 これを

 With Range("A1").CurrentRegion.resize(,7)

 アップしたコードは、続いている限りリスト範囲だと認識して、その範囲が空白かどうかチェックしているので。

 (ぶらっと)

ウッシさん、ぶらっとさん、

実際の表は1行目およびA列からI列まである固定された文字or数値があらかじめ
入力されています。最終行はその都度変化しますが、最大で100行くらいです。
また、1行目のJ1から右には日付が入っています。最終列はその都度変化しますが、
最大でAN列までです。

毎回変動する数値データor空欄の範囲はJ2から最大でAN100までになります。

説明が不明確で申し訳ありません。よろしくお願いします。

(Masa)


 こんばんは

 表例に沿った回答が出るのが普通です。
 実際の環境に合わせて修正出来ないなら最初から正確な表例を提示しないとダメです。

 まず最初の表例で最初のコードが正しく動くのか確認して、実際の表で下記のコードが正しく動くか確認して下さい。

 両方正しく動いたら双方のコードの違いが何か確認してコードの内容を理解して下さい。

 Sub test2()
    Dim m As Range
    Set m = Intersect(Range("A1").CurrentRegion, Range("J1", Range("J1").End(xlToRight)).EntireColumn)
    m.Select
    With m
        With .Offset(0, .Columns.Count).Columns(1)
            .Formula = "=IF(COUNTA(" & m.Rows(1).Address(0, 0) & ")=0,"""",1)"
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
            On Error GoTo 0
            .ClearContents
        End With
        With .Offset(.Rows.Count, 0).Rows(1)
            .Formula = "=IF(COUNTA(" & m.Columns(1).Address(0, 0) & ")=1,"""",1)"
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            On Error GoTo 0
            .ClearContents
        End With
    End With
End Sub
(ウッシ)


 私のコードなら以下。
 ウッシさんの指摘のように、アップされたレイアウトからは想像がつかなかったね。

 Sub Sample4()
    Dim r As Range
    Dim ar As Range
    Dim ac As Range

    With Range("J1", Cells(1, Columns.Count).End(xlToLeft)).Resize(Range("A1").CurrentRegion.Rows.Count - 1).Offset(1)

            For Each r In .Columns
                If WorksheetFunction.CountA(r) = 0 Then
                    If ac Is Nothing Then
                        Set ac = r
                    Else
                        Set ac = Union(ac, r)
                    End If
                End If
            Next

            For Each r In .Rows
                If WorksheetFunction.CountA(r) = 0 Then
                    If ar Is Nothing Then
                        Set ar = r
                    Else
                        Set ar = Union(ar, r)
                    End If
                End If
            Next

            If Not ac Is Nothing Then ac.EntireColumn.Hidden = True
            If Not ar Is Nothing Then ar.EntireRow.Hidden = True

    End With

 End Sub

 (ぶらっと)

ウッシさん、ぶらっとさん、

ありがとうございました。大変助かりました。

そこでもうひとつ相談ですが、マクロを実行する前に仮にJ列〜S列まで非表示になっている場合、J列〜S列のデータを対象外にして、表示されているT列〜のみを対象にマクロの実行をすることは可能でしょうか? 非表示の列はその都度変化します。
実務を想定した場合、このケースがあります。

(Masa)


 必ず非表示列が一塊ということならもう少しすっきりしたコードになるけど、
 とびとびに非表示列があってもOKの形にすると以下。

 Sub Sample5()
    Dim r As Range
    Dim ar As Range
    Dim ac As Range
    Dim aa As Range
    Dim flg As Boolean

    With Range("J1", Cells(1, Columns.Count).End(xlToLeft)).Resize(Range("A1").CurrentRegion.Rows.Count - 1).Offset(1)

            For Each r In .Columns
                If Not r.EntireColumn.Hidden Then
                    If WorksheetFunction.CountA(r) = 0 Then
                        If ac Is Nothing Then
                            Set ac = r
                        Else
                            Set ac = Union(ac, r)
                        End If
                    End If
                End If
            Next

            For Each r In .Rows
                flg = False
                For Each aa In r.Areas
                    If WorksheetFunction.CountA(aa) > 0 Then
                        flg = True
                        Exit For
                    End If
                Next

                If Not flg Then

                    If ar Is Nothing Then
                        Set ar = aa
                    Else
                        Set ar = Union(ar, aa)
                    End If

                End If
            Next

            If Not ac Is Nothing Then ac.EntireColumn.Hidden = True
            If Not ar Is Nothing Then ar.EntireRow.Hidden = True

    End With

 End Sub

 (ぶらっと)

ぶらっとさん

ありがとうございます。
このSample5でためしてみましたが、列は非表示になるのですが、行が非表示にならないです。

ちょっとみてもらえますか?

(Masa)


 う〜ん・・・・
 まだ、こちらで理解したシートの状況と、そちらの実際のシートの状況で異なるところがあるんだろうねぇ・・
 こちらでは、非表示の列を無視して表示されている列について行に値がなければ(隠れている列のその行に値があっても)その行は非表示になっているので。

 ちょっと見てみるね。

 (ぶらっと)

こんばんは

「非表示の列はその都度変化します。」って事は、表示されている列のデータを判定して行を非表示にするかどうか
決めるっていう事ですか?

データを入力したりクリアしたりする度にマクロを実行するのかな?

 Sub test3()
    Dim m As Range
    Dim v As Range
    Dim c As Long
    Set m = Intersect(Range("A1").CurrentRegion, Range("J1", Range("J1").End(xlToRight)).EntireColumn)
    Set v = m.SpecialCells(xlCellTypeVisible).EntireColumn
    c = v.Columns.Count
    With m
        With .Offset(0, .Columns.Count).Columns(1)
            Application.Calculation = xlCalculationManual
            .Formula = "=IF(VisibleCellCountA(" & m.Rows(1).Address(0, 0) & ")=0,"""",1)"
            Application.Calculation = xlCalculationAutomatic
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
            On Error GoTo 0
            .ClearContents
        End With
        With .Offset(.Rows.Count, 0).Rows(1)
            .Formula = "=IF(COUNTA(" & m.Columns(1).Address(0, 0) & ")=1,"""",1)"
            .Value = .Value
            On Error Resume Next
            .SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            On Error GoTo 0
            .ClearContents
        End With
    End With
End Sub
Function VisibleCellCountA(ByRef r As Range) As Long
    Application.Volatile
    Dim v As Variant
    Dim c As Range
    ReDim v(0 To 0)
    For Each c In r
        If Not c.EntireColumn.Hidden And Not c.EntireRow.Hidden Then
            ReDim Preserve v(UBound(v) + 1)
            v(UBound(v)) = c.Value
        End If
    Next
    VisibleCellCountA = Application.WorksheetFunction.CountA(v)
End Function

(ウッシ)


 Sample5 の

 With Range("J1", Cells(1, Columns.Count).End(xlToLeft)).Resize(Range("A1").CurrentRegion.Rows.Count - 1).Offset(1)

 これを、ウッシさんのコードのように xlToRightでやるとどうなるかな?以下のように。

 With Range("J1", Range("J1").End(xlToRight)).Resize(Range("A1").CurrentRegion.Rows.Count - 1).Offset(1)

 (ぶらっと)

ウッシさん、

そうです。表示されているデータのみで判定したいです。
test3でやってみましたが、列の非表示はうまくなるのですが、非表示のデータがあるなし関係なしにすべての行が表示されてしまいます。test2は行列共に非表示になりますが、あらかじめ非表示にしているデータもみてしまうようです。

ぶらっとさん、

xlToRightに変更してみまたが、xlToLeftと同じく非表示のデータがあるなし関係なしにすべての行が表示されてしまいます。Sample4は行列共に非表示になりますが、あらかじめ非表示にしているデータもみてしまうようです。


 う〜ん・・じゃぁお手上げだねぇ(?)
 何度も言っているけど、こちらでは列、行とも、非表示にすべきところ(私が思うところ)は非表示になっているので。
 シートの実態が異なるんだろうねぇ。

 >Sample4は行列共に非表示になりますが、あらかじめ非表示にしているデータもみてしまうようです。 

 それはそうだよね。列に非表示のものがあるという追加要件の前にアップしたコードなので。

 いずれにしても、行で言えば、値があるかどうかのチェックは aa という領域に対して行われている。

 If WorksheetFunction.CountA(aa) > 0 Then

 この上に MsgBox aa.Address

 これを入れて実行して表示される領域が、そちらで考えているチェックすべき領域と同じなのか異なるのか
 試してみると何かわかるかもね。

 領域が多いと、延々とメッセージがでてうざったいかもしれないけど双方の認識が一致しているのかどうかの確認のために。

 ↑2011/11/24 14:38 下 を 上 にコメント訂正。

 (ぶらっと)

こんにちは

Range("J1", Range("J1").End(xlToRight)).EntireColumn という列の範囲で非表示になっている
列が有る場合、その列の中には1行目以外にはデータが入っていないという事ですよね?
対象となる列が例えばJ〜AE列として、表示されている行、例えば4行目のセルJ4〜AE4のデータ
をクリアしてtest3を実行しても4行目が非表示にならないですか?

どんなデータでテストしてダメだというのかハッキリさせないといつまでたっても解決しないですよ。

出来ればコードの内容を理解してご自分の環境に合わせて修正出来るようになって下さい。

(ウッシ)


 これでもダメかな?
 Sub test()
    Dim i As Long, txt As String
    With Cells(1).CurrentRegion
        With .Offset(1).Resize(.Rows.Count - 1)
            .Value = Evaluate("index(trim(clean(" & .Address & ")),)")
            For i = 2 To .Columns.Count
                If WorksheetFunction.CountA(.Columns(i)) = 0 Then
                    txt = txt & "," & .Parent.Cells(1, i).Address(0, 0)
                End If
            Next
            If Len(txt) Then .Range(Mid$(txt, 2)).EntireColumn.Hidden = True
            txt = ""
            For i = 2 To .Rows.Count
                If WorksheetFunction.Count(.Rows(i)) = 0 Then
                    txt = txt & ",a" & i
                End If
            Next
            If Len(txt) Then .Range(Mid$(txt, 2)).EntireRow.Hidden = True
        End With
    End With
End Sub
(seiya)

ぶらっとさん、

MsgBox aa.Addressを入れて実行しました、領域はJ2:N2・・・J10:N10と表示されます。

以下、テスト用の表ですが、Sample5にてJ列とK列を非表示にしたあと実行しましたが、
4、5、8、9行目は表示されたままです。試しにJ列とK列を表示にして実行しても同じく4,5,8,9行目は表示されたままです。列の非表示は問題ないです。
@J列とK列を非表示にした場合、4,5,8,9行目は非表示にしたいです。
AJ列〜N列まですべて表示されている場合は4,8行目のみ非表示にしたいです。

混乱させて申し訳ありません。よろしくお願いします。

↓→列ABCDEFGHI   J      K      L     M     N

1            11/18   11/19   11/20   11/21  11/22
2    ABCDEFGHI    10          20            30
3    ABCDEFGHI    10           20            30
4   ABCDEFGHI
5   ABCDEFGHI     10
6   ABCDEFGHI     10          20          30
7   ABCDEFGHI     10          20           30
8   ABCDEFGHI
9   ABCDEFGHI     10
10  ABCDEFGHI     10          20            30

Sub Sample5()

    Dim r As Range
    Dim ar As Range
    Dim ac As Range
    Dim aa As Range
    Dim flg As Boolean

    With Range("J1", Range("J1").End(xlToRight)).Resize(Range("A1").CurrentRegion.Rows.Count - 1).Offset(1)

            For Each r In .Columns
                If Not r.EntireColumn.Hidden Then
                    If WorksheetFunction.CountA(r) = 0 Then
                        If ac Is Nothing Then
                            Set ac = r
                        Else
                            Set ac = Union(ac, r)
                        End If
                    End If
                End If
            Next

            For Each r In .Rows
                flg = False
                For Each aa In r.Areas
                    MsgBox aa.Address
                    If WorksheetFunction.CountA(aa) > 0 Then
                        flg = True
                        Exit For
                    End If
                Next

                If Not flg Then

                    If ar Is Nothing Then
                        Set ar = aa
                    Else
                        Set ar = Union(ar, aa)
                    End If

                End If
            Next

            If Not ac Is Nothing Then ac.EntireColumn.Hidden = True
            If Not ar Is Nothing Then ar.EntireRow.Hidden = True

    End With

 End Sub


 あぁ、やっとわかった。ごめん。途中で、 aa を登場させたときのバグ。

                    If ar Is Nothing Then
                        Set ar = aa
                    Else
                        Set ar = Union(ar, aa)
                    End If

 これを

                    If ar Is Nothing Then
                        Set ar = r
                    Else
                        Set ar = Union(ar, r)
                    End If

 これで試してみてくれる?

 (ぶらっと)

ぶらっとさん、

@J列とK列を非表示にした場合、4,5,8,9行目は非表示にしたいです。
 →結果、4、8行目は非表示になりますが、5、9行目は表示されたままです。
  MsgBox aa.Addressで表示された領域を見ると、J列とK列を含んでいることが原因でしょうか?
  ちなみに、あらかじめ非表示されている列はその都度変化します。
Aは問題ないです。

(Masa)


 >MsgBox aa.Addressで表示された領域を見ると、J列とK列を含んでいることが原因でしょうか?

 J,K列が非表示なら aa のアドレスには J,K列は含まれないはずだけど・・・?
 なやむねぇ。

 >ちなみに、あらかじめ非表示されている列はその都度変化します。 

 もちろん、織り込み済みだけどねぇ・・・

 まだ、どこか、勘違いしてるのかなぁ・・・

 追記)22:24

   ↑で偉そうに講釈をたれたけど、よくコードをみたら、メチャクチャ。おそまつ。ペコリ!

 修正版です。

 Sub Sample6()
    Dim rr As Range
    Dim r As Range
    Dim ar As Range
    Dim ac As Range
    Dim aa As Range
    Dim flg As Boolean

    With Range("J1", Range("J1").End(xlToRight)).Resize(Range("A1").CurrentRegion.Rows.Count - 1).Offset(1)

        For Each r In .Columns
            If Not r.EntireColumn.Hidden Then
                If WorksheetFunction.CountA(r) = 0 Then
                    If ac Is Nothing Then
                        Set ac = r
                    Else
                        Set ac = Union(ac, r)
                    End If
                End If
            End If
        Next

        For Each rr In .Rows

            Set r = Nothing
            On Error Resume Next
            Set r = rr.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0

            If Not r Is Nothing Then
                flg = False
                For Each aa In r.Areas
                    If WorksheetFunction.CountA(aa) > 0 Then
                        flg = True
                        Exit For
                    End If
                Next

                If Not flg Then

                    If ar Is Nothing Then
                        Set ar = r
                    Else
                        Set ar = Union(ar, r)
                    End If

                End If

            End If

        Next

        If Not ac Is Nothing Then ac.EntireColumn.Hidden = True
        If Not ar Is Nothing Then ar.EntireRow.Hidden = True

    End With

 End Sub

 (ぶらっと)

 こんばんは
 こちらで最後の表例で、test3 を実行すると、
(1)J列とK列を非表示にした場合、4,5,8,9行目は非表示にしたいです。 
(2)J列〜N列まですべて表示されている場合は4,8行目のみ非表示にしたいです。 
 になりますけど、ダメですか?
(ウッシ)

ぶらっとさん、

Sample6でやってみたところうまく動きました。ありがとうございました。

ウッシさん、
test3でやってみましたが、@Aのケースともに行が非表示にならないです。
すべて表示されてしまいます?

(Masa)


 こんばんは
 もう、ちょっと分からないですね。
 こちらで
↓→列ABCDEFGHI   J      K      L     M     N 
行 
1            11/18   11/19   11/20   11/21  11/22 
2    ABCDEFGHI    10          20            30 
3    ABCDEFGHI    10           20            30 
4   ABCDEFGHI 
5   ABCDEFGHI     10 
6   ABCDEFGHI     10          20          30 
7   ABCDEFGHI     10          20           30 
8   ABCDEFGHI 
9   ABCDEFGHI     10 
10  ABCDEFGHI     10          20            30 
のデータで試すと、test3もぶらっとさんのSample6も同じ動きをします。
(ウッシ)

コメント返信:

[ 一覧(最新更新順) ]


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