チェックで指定行を非表示

質問

チェックボックスでチェックしたらもしくはボタンを押したら指定行を非表示になるようにしたいのですがどなたか解る方よろしく願います。

回答No.1

imogasi · ベストアンサー

下記は捨石の回答です。質問で状況が十分説明されてない（注１）と思うからです。
下記で仮定している状況が、質問例の簡単化のために、質問者がそう書いたので、実際は複雑なら、その旨を後の回答者のために、ぜひ追記してください。
ーー
例データ
Ｓｈｅｅｔ１で
第１行は見出しなどとして考慮除外する。
Ａ２：Ｂ１３　Ｃ列は考慮しない。
１
ーー A　ーーは実際は空白セルＡ列。左に寄って表示されるので、入れたもの。実際はないもの。
ーー B
ーー C
２
ーー A
ーー B
ーー C
３
ーー A
ーー B
ーー C
とする。
シート１の「ダブル」クリックイベントに（クリックは、より多く使われると思い、こちらにした）
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
MsgBox Target.Offset(, 1)
MsgBox Int((Target.Row - 1) / 4) + 1
If Target.Offset(, 1) = Int((Target.Row - 1) / 4) + 1 Then
r = Target.Row
x = (r + 1) & ":" & (r + 3)
MsgBox x
Rows(x).EntireRow.Hidden = True
Else
End
End If
End If
End Sub
を入れる。
Ａ列第２行目、Ａ列６行目、Ａ列１０行目などを、それぞれダブルクリックすると、３から５、７から９、１１から１３行目までを非表示にします。
ＭｓｇＢｏｘはテスト用なので、本番では省いてください。
（注１）仮定が明確でない。ＡＢＣの３行と小生は仮定しているが、ＡＢＣＤやＡＢの行はないのか。
ーー
チェックボックスを使っていないわけは、チェックボックスが置かれていると見えるセル（の行）が、そもそもあいまいと思うから。コントロールは、特定の行に張り付いたものではないと思う（小生の不勉強で間違っておれば、他の回答者の回答を待ちます）。すなわち特定のコントロールから、所属行を割り出せない（エクセルの）仕組みと思うから。
ーー
繰り返しのテストで非表示を解除する必要があるなら
Sub test02()
Rows.Hidden = False
End Sub
を、標準モジュールに入れて、実行してください。
ーー
ボタンをトリガーにするほうほうはある。その場合は置かれたセル８アクチブセル）に全面的に頼ることになるが、セルのアクチブ場所を気にしないと、おボタンをクリックした後にアクチブセルが間違っていたなどというケースの心配をして、今回はそのコードは略。
ーー
MsgBox Int((Target.Row - 1) / 4) + 1
If Target.Offset(, 1) = Int((Target.Row - 1) / 4) + 1 Then
はＡの上の行をクリックしたことのチェックを入れている。
また
If Target.Column = 1 Then
も、ダブルクリックした列のチェックのためです。

お礼

有難うございます。助かりました。

回答No.2

mitarashi

規則性に気がつきませんでしたので(^^;)
チェックボックス代替の文字で判別するコードです。ご参考まで。
コントロールを使うと設置が面倒なので、チェック有無の特殊文字(Unicode &H2610,&H2611)を使っています。SelectionChangeを使っているので、実行後次の列にActiveCellを移動して、同じセルで連続的に実行出来る？様にしてみました。
次のチェックボックスを見つけるのにRange.End(xlDown)とかではなく、Findを用いているのは、単にやってみたかっただけの理由です。エラー処理は不十分です。
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim myCell As Range, hitRange As Range
'Eventから抜ける条件設定
If target.Cells.Count > 1 Then Exit Sub
If target.Column <> 1 Then Exit Sub
If target.Value = "" Then Exit Sub

Select Case target.Value
Case ChrW(&H2610) 'unchecked
target.Value = ChrW(&H2611)
Set hitRange = findFollowingBlankCell(target)
Application.EnableEvents = False
target.Offset(0, 1).Activate
Application.EnableEvents = True
If Not hitRange Is Nothing Then
'折り畳み
For Each myCell In hitRange
myCell.EntireRow.Hidden = True
Next myCell
End If
Case ChrW(&H2611) 'checked
target.Value = ChrW(&H2610)
Set hitRange = findFollowingBlankCell(target)
Application.EnableEvents = False
target.Offset(0, 1).Activate
Application.EnableEvents = True
If Not hitRange Is Nothing Then
'折り畳み解除
For Each myCell In hitRange
myCell.EntireRow.Hidden = False
Next myCell
End If
End Select
End Sub

Function findFollowingBlankCell(target As Range) As Range
Dim nextCell As Range

On Error Resume Next
Set nextCell = target.EntireColumn.Find(What:="*" _
, After:=target _
, LookIn:=xlValues _
, LookAt:=xlPart _
, SearchOrder:=xlByColumns _
, SearchDirection:=xlNext _
, MatchCase:=False _
, MatchByte:=False _
, SearchFormat:=False)
If Err.Number <> 0 Or nextCell Is Nothing Then
Set findFollowingBlankCell = Nothing
Else
If nextCell.Row - target.Row > 1 Then
With Me
Set findFollowingBlankCell = .Range(target.Offset(1, 0), nextCell.Offset(-1, 0))
End With
Else
Set findFollowingBlankCell = Nothing
End If
End If
End Function

Wクリックで未チェックの□を入力するコードもおまけで付けます。
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
If target.Column <> 1 Then Exit Sub
Cancel = True
If target.Value = "" Then
target.Value = ChrW(&H2610)
End If
End Sub

お礼

有難うございます。