• ベストアンサー

Excelで作成した住所録にオートフィルタをかけ、ユーザーフォームで1件ずつ表示

エクセル2007を使用して住所録を作成しています。 一行に1名ずつの情報(各列に氏名など)が入るようになっています。 A列にリスト番号・B列に氏名、といった感じで作成しています。 一覧表示だと列の数が多く個別の内容が分かりにくいため、 ユーザーフォームを使って1件ずつ詳細を見られるようにしました。 ユーザーフォームに付けたコマンドボタン「次」を押すと 順番(住所録リストの上から順)に個別の内容が表示されるように したのですが、オートフィルタをかけてしまうと 非表示のリストもユーザーフォームに表示されてしまいます。 そこで、いくつかの参考書などを使って組んでみたのですが、 私の作ったものではコマンドボタン「次」を押すと オートフィルタで表示されている一番下の リストにユーザーフォームの内容が飛んでしまいます。 どのようにすれば、オートフィルタで表示されているリストのみを 順番にユーザーフォームに表示ができるのでしょうか? 私が作ったものです。↓ Private Sub cmd次_Click() Dim r As Range, rr As Range, rs As Range If Not Worksheets("名簿").AutoFilterMode Then  データ行 = データ行 + 1 Else Set r = Worksheets("名簿").Range("A3", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible) For Each rr In r For Each rs In rr.Areas データ行 = rs.Row Next rs Next  End If 表示データ変更 End Sub このような質問で分かりにくいようでしたらすみません。 どなたかご教授いただければ幸いです。

noname#181520
noname#181520

質問者が選んだベストアンサー

  • ベストアンサー
  • fujillin
  • ベストアンサー率61% (1594/2576)
回答No.2

次の非表示ではない(=表示されている)行を取得できればよいということですよね?  Do   データ行 = データ行 + 1  Loop Until Not Rows(データ行).Hidden でいけると思います。 最大行数に制限があるなどの場合は、判断条件にそれを追加してください。

noname#181520
質問者

お礼

fujillin様 お返事が遅くなり申し訳ありません。 必要に応じて多少のアレンジは致しましたが ご回答頂いたコードでうまく出来ました。 私が作ったものよりも簡潔で、非常に助かりました。 ありがとうございました。

その他の回答 (2)

  • kmetu
  • ベストアンサー率41% (562/1346)
回答No.3

Private Sub 進む_Click() Do ActiveCell.Offset(1, 0).Activate Loop Until Rows(ActiveCell.Row).Hidden = False TextBox1 = ActiveCell.Value End Sub Private Sub 戻る_Click() Do ActiveCell.Offset(-1, 0).Activate Loop Until Rows(ActiveCell.Row).Hidden = False TextBox1 = ActiveCell.Value End Sub でいかがでしょう

noname#181520
質問者

お礼

kmetu様 お返事が遅くなり申し訳ありません。 fujillin様の回答と組み合わせてアレンジし、 うまく組むことが出来ました。 しかも「戻る」のコードまで頂き、 とても助かりました。 ありがとうございました。

  • hana-hana3
  • ベストアンサー率31% (4940/15541)
回答No.1

>どのようにすれば、オートフィルタで表示されているリストのみを順番にユーザーフォームに表示ができるのでしょうか? 簡単にできそうですがフィルタ中のリスト操作はVBAでも無理な事なのです・・・。 フィルタ結果を別シートにコピーして利用してください。

noname#181520
質問者

お礼

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

関連するQ&A

  • エクセル VBA ユーザーフォームの表示

    excel2000にてシートのB列のみで65行目以下をWクリックするとユーザーフォームが表示されるというコードを教えてください。 以下は調べたりした結果のコードです。B列をWクリックすると表示される状態です。 B60とかをクリックしても表示されないようにしたいです。 Worksheetのコード Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True If Target.Column = 2 Then 'B列なら   行 = Target.Row '行番号を取得する   UserForm1.Show 'ユーザーフォームを表示する End If End Sub 標準モジュールのコード Option Explicit Public 行 As Variant '行番号 Sub auto_open() Load UFnyuuryoku 'ユーザーフォームをメモリに読み込む End Sub ご存知の方よろしくお願いします。

  • オートフィルタをフォーム上(VBA)で実現 2回目

    http://okwave.jp/qa/q8423348.html 前回も、オートフィルタをフォーム上で実現させる方法について 質問させていただきました。 Excel2003を仕様しております。 一通り、オートフィルタをフォーム上で再現することは出来たのですが、 使い方が悪いのか、上手く表示できないことがあります。 例) ユーザーフォーム上にCombobox1~Combobox3まであります。 Comboboxどれかが変更されたら、空のコンボボックスのリストを再取得します。 ----------------------------------------------- Sub Combobox_Renew_ChangeJob(ByVal ComboboxName As Object, ByVal ColumnNumber As Long) Application.ScreenUpdating = False '画面更新しない(ちらつき防ぐ) With ThisWorkbook.Worksheets("データ") If ComboboxName = "" Then 'コンボボックスが空だった場合 .Select .Range("A1").AutoFilter Field:=ColumnNumber 'フィルター解除! ElseIf ComboboxName <> "" Then 'コンボボックスが空じゃない場合 .Select .Range("A1").AutoFilter Field:=ColumnNumber, Criteria1:=ComboboxName.Text End If Result = WorksheetFunction.Subtotal(3, Range("B:B")) 'B列の可視セルがいくつあるか If Result = 1 Then MsgBox "一致するデータはありませんでした。" & vbCrLf & " 再度絞り込みなおしてください。" .Select .Range("A1").AutoFilter Field:=ColumnNumber 'フィルター解除! ComboboxName = "" End If End With Call ComboBox_Renewal 'コンボボックス更新 End Sub ------------------------------------------------------------ Sub ComboBox_Renewal() Application.ScreenUpdating = False '画面更新しない(ちらつき防ぐ) Dim LastData As Long With ThisWorkbook.Worksheets("データ") .Select LastData = Cells(Rows.Count, 2).End(xlUp).Row 'B列最終行を取得 If (Me.ComboBox1 = "") Then Me.ComboBox1.Clear Me.ComboBox1.List = Module1.Get_Unique_and_Visible_List(.Range("E2:E" & LastData)) '[E] Me.ComboBox1.AddItem "" Else Result = Combo1.ListIndex Me.ComboBox1.Clear Me.ComboBox1.SetFocus End If If (Me.ComboBox2 = "") Then Me.ComboBox2.Clear Me.ComboBox2.List = Module1.Get_Unique_and_Visible_List(.Range("C2:C" & LastData)) '[C] Me.ComboBox2.AddItem "" End If If (Me.ComboBox3 = "") Then Me.ComboBox3.Clear Me.ComboBox3.List = Module1.Get_Unique_and_Visible_List(.Range("D2:D" & LastData)) '[D] Me.ComboBox3.AddItem "" End If End With End sub ------------------------------------ Private Sub ComboBox1_AfterUpdate() Application.ScreenUpdating = False '画面更新しない(ちらつき防ぐ) With ThisWorkbook.Worksheets("データ") Call Combobox_Renew_ChangeJob(ComboBox1, .Range("E1").Column) End With End Sub Private Sub ComboBox2_AfterUpdate() Application.ScreenUpdating = False '画面更新しない(ちらつき防ぐ) With ThisWorkbook.Worksheets("データ") Call Combobox_Renew_ChangeJob(ComboBox2, .Range("C1").Column) End With End Sub Private Sub ComboBox3_AfterUpdate() Application.ScreenUpdating = False '画面更新しない(ちらつき防ぐ) With ThisWorkbook.Worksheets("データ") Call Combobox_Renew_ChangeJob(ComboBox3, .Range("D1").Column) End With End Sub ----------------------------------------- 上記の方法を使っていますが、 Comboboxに値を全て入れたあと、 絞り込みされていると考え、リストを更新しておりません。 そのため、最初のほうにコンボボックスにデータを入力したものは 選択できてしまいます。 一番最初に選んだComboboxは、 リストが全て残っている状態です。 そのため、他のComboboxで絞り込んだ後、 一番最初に選んだComboboxでは他の値が選択できてしまいます。 説明が下手で分かりにくいかもしれませんが… 何か良い改善方法があれば、教えて頂きたいです! よろしくお願い致します!!

  • ユーザーフォーム

    こんばんは。 またまた教えていただきたく思います。ユーザーフォームにリスト ボックスをセットし、シート(商品一覧)のa2からy10までを表示 させたいのですがcまでしか表示できません。宜しくお願いします。 Sub リスト読み込み() Dim myDCount As Long, myDRange As String Worksheets("商品一覧").Activate myDCount = Worksheets("商品一覧").Range("b1").CurrentRegion.Rows.Count + 1 myDRange = "a2:y" & myDCount ListBox1.ColumnCount = 3 ListBox1.ColumnWidths = "60;60;60" ListBox1.RowSource = myDRange End Sub

  • ユーザーフォームのデータ

    ユーザーファームを2つ作成しました。 そのユーザーフォームのデータを表の最終行に追加をしたいのです。 Range("A65536").End(xlUp).Offset(1,0).select を使おうと思っていますが、うまくいきません。 どなたか教えてください。 <ユーザーフォーム1> Private Sub CommandButton1_Click() Sheet2.Range("H7") = TextBox1 Sheet2.Range("I7") = TextBox2 Sheet2.Range("J7") = TextBox3 Sheet2.Range("K7") = TextBox4 Sheet2.Range("L7") = TextBox5 Sheet2.Range("P7") = TextBox6 If CheckBox1.Value = True Then Worksheets(2).Range("M7") = "0:30" Else Worksheets(2).Range("M7") = "0:00" End If If CheckBox2.Value = True Then Worksheets(2).Range("R7") = "1000" Else Worksheets(2).Range("R7") = "0" End If If CheckBox3.Value = True Then Worksheets(2).Range("S7") = "3000" Else Worksheets(2).Range("S7") = "0" End If If CheckBox4.Value = True Then Worksheets(2).Range("T7") = "1500" Else Worksheets(2).Range("T7") = "0" End If Unload Me End Sub <ユーザーフォーム2> Private Sub CommandButton1_Click() Sheet2.Range("V7") = TextBox1 Sheet2.Range("W7") = TextBox2 Sheet2.Range("X7") = TextBox3 Unload Me End Sub

  • エクセルVBA オートフィルタの選択を元に戻す

    エクセルのVBAで、次のことはできるでしょうか。 ブックの中の3つのシートはオートフィルタが設定してあり、任意で操作し、検索に使っています。(オートフィルタを設定しないしーとが2つあります) ・別のシートにチェンジしたら、チェンジ前のシートがオートフィルタで特定の行だけを表示していたら、オートフィルタを <すべて> に戻して、消えていた行を全て表示させたいのです。(オートフィルタは次回にまた使うので、データ-フィルタ-オートフィルタでオートフィルタ自体を解除してしまうような状態にはしたくありません) ・同じく、上記のことをブックを閉じるときにも実行したいのです。 ちなみに、オートフィルタをかけてあるシートには、以下のコードがあります。 よろしくお願いします。 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) With Sheets("印刷") .Range("E15:E17").Value = _ Application.Transpose(Cells(Target.Row, 7).Resize(, 3).Value) .Range("AA16").Value = _ Cells(Target.Row, 10).Value .Range("AQ16").Value = _ Cells(Target.Row, 11).Value .Range("AX16").Value = _ Cells(Target.Row, 12).Value End With With Sheets("施設") .Range("C2").Value = _ Cells(Target.Row, 10).Value End With Cancel = True Sheets("施設").Select End Sub

  • Excel オートフィルタのリストを取得したい

    ExcelのVBAです。 オートフィルタの▼をクリックすると、 重複していないリストが出ます。 このリストを列ごと(指定列)取得したいです。 できれば、Functionで組み、 配列に格納し、使いたいと思っています。 戻り値で配列は出来なかった気がしますが、 どうでしょうか… やりたいことをまとめます。 ---------------------- Call オートフィルタリスト("A") 配列をリストボックスに表示 選択し、上下の配置などを変更できるように (Excelも連動し、2行目と3行目の位置を変更したりすることができる) 新規追加 そのリスト最終行に新規データを入力 そして、それをExcelにも反映 ------------------------ Function オートフィルタリスト(指定列) 配列定義 指定列の範囲選択 オートフィルタのリストを配列に格納 (重複は削除します) 配列を返します。 End Function ------------------------------ まとめるどころか余計ぐちゃぐちゃした気もしますが、 回答よろしくお願い致します。

  • エクセル2007で行にオートフィルタをかけたい

    エクセル2007で行データにオートフィルタをかけたいのですが できません. 範囲をどのように選択してもかならず列データにオートフィルタが かかってしまうのですが どうにかして行データにオートフィルタをかけたいです. どなたかご教授願います

  • Excelのリストボックスで(VBA・ユーザーフォーム)

    ユーザーフォームにあるリストボックスに、2列のデータを表示しています このデータを選択すると、シートのセルに転記するようにしたいのですが、うまく行きません 今のコードはこのようになっています Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Sheets(1).Range("A1").Value = ListBox1.Value End Sub このコードで1列目のデータがA1に入るのですが、B1に2列目のデータを入れたいのですが出来ません 例えば、リストボックスが下のような場合 コード 商品名 00001 お茶 00002 紅茶 00003 コーヒー 紅茶の行を選択したら、A1に00002、B1に紅茶と入力されるようにしたいのです どのようにすればよいのか教えて下さい よろしくお願い致します

  • エクセルでフォームのDropDownとオートフィルタのDropDown

    エクセルでフォームのDropDownとオートフィルタのDropDownについて。 エクセル2000です。 ワークシート上にフォームのDropDown(コンボボックス)や、オートフィルター、そして入力規則でリストの設定があります。 今のVBAの書き方だとこれらはすべてShapeです。 そうすると、フォームのDropDownとオートフィルター、そして入力規則のリストの識別がVBAではとても難しいです。これらはすべてTypeは msoFormControlですし、さらにFormControlTypeも xlDropDownとまったく同一です。 なんとか識別する方法がないか昨夜から試行錯誤の結果、オートフィルター、そして入力規則のリストはシート上に貼り付けてあるわけではないためか、TopLeftCellが取得できないことに気づきました。そこで下記のような識別のための実験コードを書いてみたのですが、多分もっといい方法があるのではと思い、質問させていただきます。 もちろん、Shapesコレクションを使用せず、古いDrawingObjectsコレクションを持ち出せばオートフィルターや入力規則は最初から対象外となるのは存じておりますのでそれ以外の方法をご教示くださいませ。 (o。_。)oペコッ. Sub hantei()  Dim i As Integer, x As String  Dim Obj As Object   For Each Obj In ActiveSheet.Shapes     If Obj.Type = msoFormControl Then       If Obj.FormControlType = xlDropDown Then         On Error Resume Next         x = Obj.TopLeftCell.Address         On Error GoTo 0         If x = "" Then           i = i + 1         Else           x = ""         End If       End If     End If   Next   MsgBox i & "個、入力規則のリストまたはオートフィルターがあります。" End Sub

  • オートフィルタで「・・で始まる」数値の抽出方法

    VBAでオートフィルタを使用して「95」から始まるデータを抽出して、そのデータを1行目の項目行を省いて別シートの最終行に貼り付けするマクロを作成していますが、上手くいかない部分があり困っています。 オートフィルタはセルに入っている値が数値データの場合は「○○で始まる」検索オプションが使えない仕様とのことです。 https://support.microsoft.com/ja-jp/kb/170230 数字をテキスト形式に変換すれば文字列として扱われるので、上記の検索オプションが使えるとのことで数値が入った列を全て文字列にしようとしましたが、上手くいきません。 下記のコードが一部抜粋のコードで、A列にオートフィルタで抽出したい5桁の数値が入っているとします。 元シート(移動先シートも同じような構成でデータが入っている) A    B   C   D    E ID   品名  単価  数量  金額 92153 りんご 100   10   1000 95235 ばなな 150   15   2250 95589 みかん 50   20   1000 87896 ぶどう 200   7   1400 Dim LastRow As Long, mySt(1) As Worksheet ActiveWorkbook.Worksheets("元シート").Activate Set mySt(0) = Worksheets("元シート") Set mySt(1) = Worksheets("移動先シート") Columns("A:A").Select Selection.NumberFormatLocal = "@" '←選択列を文字列にしようとしたが上手くいかず With mySt(0) LastRow = .Cells(Rows.Count, 1).End(xlUp).Row With .Range(.Rows(1), .Rows(LastRow)) .AutoFilter Field:=1, Criteria1:="95*", Operator:=xlAnd With .SpecialCells(xlCellTypeVisible) .Copy mySt(1).Rows(1) End With End With End With また、オートフィルタで抽出したデータをコピーして、既にデータが入っている移動先シートの最終行に貼り付けたいのですが、上手くいかず、2行目に貼り付けられてしまいます。 移動先シートの最終行の取得と貼付け方法が検索してもよく分からず困っています。 2点につきまして、分かる方がいましたら教えて頂けますと助かります。 よろしくお願いいたします。

専門家に質問してみよう