回答 受付中

VBA チェックした項目以外を非表示

  • すぐに回答を!
  • 質問No.9597147
  • 閲覧数103
  • ありがとう数2
  • 気になる数1
  • 回答数6

お礼率 52% (82/156)

現在下記のようなコードがあります。

C列に項目が入力されており
そのC列に入力されている項目と同じ文字が
ユーザーフォームのチェックボックスのキャプションになっています。

今回やりたいのはチェックボックスにチェックした項目以外を
非表示にしたいというものですが
現状は、1つだけのチェックなら正常に機能します。
2つ以上チェックしてしまうとオブジェクト名が大きい方が優先されて
しまい1つだけの項目しか表示されません。

どのようにコードを書き換えればよろしいでしょうか?

Private Sub CommandButton1_Click()
Dim i As Integer
Dim d As Date
Dim y As Date
Dim myMSG As String
Dim myFlg As Boolean
Dim rng As Range
Dim rng2 As Range



myFlg = False
For i = 1 To 14
If Me.Controls("CheckBox" & i).Value = True Then
myMSG = Me.Controls("CheckBox" & i).Caption
myFlg = True
End If
Next i
If myFlg = False Then
GoTo Label1
End If

Set rng2 = Range("C:C").Find(what:=myMSG, lookat:=xlWhole)

If rng2 Is Nothing Then

MsgBox Me.ComboBox1 & "日に" & myMSG & "は使用していません。", vbInformation
Exit Sub
Else
For x = 2 To Range("C65536").End(xlUp).Row
If Range("C" & x).Value <> myMSG Then
Rows(x & ":" & x).EntireRow.Hidden = True
End If
Next x
End If

End Sub

回答 (全6件)

  • 回答No.6

ベストアンサー率 43% (189/433)

今晩は
失礼ながらExcelのVBAは素人ですが、一つ気が付いたこと

>現状は、1つだけのチェックなら正常に機能します。
>GoTo Label1
Label1:
が見当たりません
お礼コメント
yyrd0421

お礼率 52% (82/156)

ご指摘ありがとうございます。
コードを切り貼りしてしまった為
このようなことになってしまいました。
今後はすべてのコードを乗せるようにいたします。
投稿日時 - 2019-03-18 07:56:01
  • 回答No.5

ベストアンサー率 59% (174/291)

Excel(エクセル) カテゴリマスター
先ほどのコードでも大丈夫ですが
より見やすいコードに手直ししてみました。


Option Explicit

Private Sub CommandButton1_Click()

 Dim TgSheet As Worksheet '対象のワークシート
 Dim LastRow As Long   '対象行末行番号
 Dim i As Long      'チェックボックスカウンター
 Dim myMSG As String   'キャプション
 Dim HitFlg As Boolean
 Const CBoxCount = 3  'チェックボックスの数  本当は14?

 Application.ScreenUpdating = False

 '対象シートを設定
 Set TgSheet = ThisWorkbook.Sheets(1)

 '対象シートを全行表示
 TgSheet.Range(Rows(2), Rows(65536)).EntireRow.Hidden = False

 '対象行範囲末を取得
 LastRow = TgSheet.Range("C65536").End(xlUp).Row

 '対象行範囲を全行非表示
 TgSheet.Range(Rows(2), Rows(LastRow)).EntireRow.Hidden = True

 '対象行を表示
 For i = 1 To CBoxCount
  If Me.Controls("CheckBox" & i).Value = True Then
   myMSG = Me.Controls("CheckBox" & i).Caption
   HitFlg = RowShow(TgSheet, myMSG, LastRow)
   If HitFlg = False Then
    MsgBox Me.ComboBox1.Text & "日に" & myMSG & "は使用していません。", vbInformation
   End If
  End If
 Next i

 Application.ScreenUpdating = True

End Sub

'//-------------------------------------------
' 指定列が指定文字列だったらその行を表示する関数
  'TgSheet As Worksheet 対象シート
  'ShowText As String  表示対象テキスト
  'LastRow As Long   チェックする行末の番号
  '戻り値 該当行があったか
'//-------------------------------------------
Function RowShow(TgSheet As Worksheet, _
  ShowText As String, LastRow As Long) As Boolean

 Const CheckCol = 3 'C列
 Dim RC As Long  '行カウンター
 Dim HitFlg As Boolean 'ヒットフラグ

 HitFlg = False
 For RC = 2 To LastRow '対象行末まで繰り返し
  If TgSheet.Cells(RC, CheckCol).Value = ShowText Then
   TgSheet.Range(Rows(RC), Rows(RC)).EntireRow.Hidden = False
   HitFlg = True
  End If
 Next RC

 RowShow = HitFlg

End Function
  • 回答No.4

ベストアンサー率 59% (174/291)

Excel(エクセル) カテゴリマスター
私だったら、難しく考えず
1.行全体を表示
2.行範囲末を特定
3.行範囲を非表示
4.条件に合った行を表示
 4をチェックボックスの数、対象行範囲数繰り返します。

以下コードサンプルです


Option Explicit

Private Sub CommandButton1_Click()

 Dim TgSheet As Worksheet '対象のワークシート
 Dim LastRow As Long   '対象行末行番号
 Dim i As Long      'チェックボックスカウンター
 Dim myMSG As String   'キャプション
 
 Const CBoxCount = 3  'チェックボックスの数
 
 Application.ScreenUpdating = False
 
 '対象シートを設定
 Set TgSheet = ThisWorkbook.Sheets(1)
 
 '対象シートを全行表示
 TgSheet.Range(Rows(2), Rows(65536)).EntireRow.Hidden = False
 
 '対象行範囲末を取得
 LastRow = TgSheet.Range("C65536").End(xlUp).Row

 '対象行範囲を全行非表示
 TgSheet.Range(Rows(2), Rows(LastRow)).EntireRow.Hidden = True
 
 '対象行を表示
 For i = 1 To CBoxCount
  If Me.Controls("CheckBox" & i).Value = True Then
   'RowShow TgSheet, "aaa", LastRow
   myMSG = Me.Controls("CheckBox" & i).Caption
   RowShow TgSheet, myMSG, LastRow
  End If
 Next i
 
 Application.ScreenUpdating = True
 
End Sub


Function RowShow(TgSheet As Worksheet, ShowText As String, LastRow As Long)
 
 'TgSheet As Worksheet 対象シート
 'ShowText As String  表示対象テキスト
 'LastRow As Long   チェックする行末の番号
 
 Const CheckCol = 3 'C列
 Dim RC As Long  '行カウンター
 Dim HitFlg As Boolean 'ヒットフラグ
 
 HitFlg = False
 For RC = 2 To LastRow '対象行末まで繰り返し
  If TgSheet.Cells(RC, CheckCol).Value = ShowText Then
   TgSheet.Range(Rows(RC), Rows(RC)).EntireRow.Hidden = False
   HitFlg = True
  End If
 Next RC

 If HitFlg = False Then
  MsgBox Me.ComboBox1.Text & "日に" & ShowText & "は使用していません。", vbInformation
 End If
 
End Function
  • 回答No.3

ベストアンサー率 54% (464/853)

No1No2の追加です。元の流れ(GoTo Label1)を現在地に残すのでしたら
動的配列ReDimを使って
Dim i As Integer, k As Integer
Dim LMSG As String, myMSG() As String
Dim rng2 As Range
Dim myFlg As Boolean

k = 1
myFlg = False
For i = 1 To 14
If Me.Controls("CheckBox" & i).Value = True Then
ReDim Preserve myMSG(k)
myMSG(k) = Me.Controls("CheckBox" & i).Caption
k = k + 1
myFlg = True
End If
Next i
If myFlg = False Then
GoTo Label1
End If
Rows("1:65536").EntireRow.Hidden = True
For i = 1 To UBound(myMSG)
Set rng2 = Range("C:C").Find(what:=myMSG(i), lookat:=xlWhole)
If Not rng2 Is Nothing Then
rng2.EntireRow.Hidden = False
Else
LMSG = LMSG & myMSG(i) & ","
End If
Next i
MsgBox "Me.ComboBox1" & "日に " & Left(LMSG, Len(LMSG) - 1) & " は使用していません。", vbInformation
  • 回答No.2

ベストアンサー率 54% (464/853)

No1です。追加です。

配列を使わすにもっと単純な方法です。
GoTo Label1とかに関連するようなところは付け足してください。
ただ、あまりGoToは使わない方がいいと思います。

Dim i As Integer
Dim LMSG As String, myMSG As String
Dim rng2 As Range

Rows("1:65536").EntireRow.Hidden = True
For i = 1 To 14
If Me.Controls("CheckBox" & i).Value = True Then
myMSG = Me.Controls("CheckBox" & i).Caption
Set rng2 = Range("C:C").Find(what:=myMSG, lookat:=xlWhole)
If Not rng2 Is Nothing Then
rng2.EntireRow.Hidden = False
Else
LMSG = LMSG & myMSG & ","
End If
End If
Next i
MsgBox Me.ComboBox1 & "日に " & Left(LMSG, Len(LMSG) - 1) & " は使用していません。", vbInformation
  • 回答No.1

ベストアンサー率 54% (464/853)

myMSG = Me.Controls("CheckBox" & i).Caption

で最後のチェックボックスのキャプションがmyMSGに代入されるだけでそれ以前のものは上書きされてしまいます。

たとえば簡単な例として

muMAGを配列にして
Dim myMSG(14) as string

myMSG(i) = Me.Controls("CheckBox" & i).Caption

Rows("1:65536").EntireRow.Hidden = True
For i = 1 To 14
Set rng2 = Range("C:C").Find(what:=myMSG(i), lookat:=xlWhole)
If Not rng2 Is Nothing Then
rng2.EntireRow.Hidden = False
End If
Next
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

関連するQ&A

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

特集

ピックアップ

ページ先頭へ