[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロにて行列を非表示にしたい』(Masa)
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.