• 締切済み

エクセル VBA リストボックス 一覧処理

エクセル VBA リストボックス 一覧処理 シートから文字列を検索 ↓ リストボックス表示 ↓ 表示結果をクリック ↓ 空欄時入力 ↓ 更新 上記の流れをVBAで行いたいのですが、結果表示されたリストを選択 詳細を表示し、空欄においては都度入力した物を更新ボタンでセルへ 反映させるにはどの様にすればいいのでしょうか? Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim SAGASU As Object Dim KensakuChar As String Dim ListNamae As String Dim ListChar As String Dim KBanme As Integer Dim LBanme As Integer Set SAGASU = Worksheets("2月") MaxRows = SAGASU.UsedRange.Rows.Count Nagasa = Len(Namae) MeNamae.ListBox1.Clear For i = 3 To MaxRows ListNamae = SAGASU.Cells(i, 3) KBanme = 0 LBanme = 0 Do Do While Nagasa >= KBanme KBanme = KBanme + 1 KensakuChar = Mid(Namae, KBanme, 1) If KensakuChar <> " " Then Exit Do End If Loop Do While Nagasa >= LBanme LBanme = LBanme + 1 ListChar = Mid(ListNamae, LBanme, 1) If ListChar <> " " Then Exit Do End If Loop If KensakuChar = ListChar Then If Nagasa = KBanme Then With MeNamae .ListBox1.AddItem (ListNamae) End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub --------------- Private Sub UserForm_Initialize() Set SAGASU = Worksheets("2月") Maxl = SAGASU.UsedRange.Rows.Count End Sub --------------- Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As Object Namae = TextBox1.Text Set MeNamae = KensakuForm Call 検索(Namae, MeNamae) End Sub ---------------- Private Sub CommandButton2_Click() End End Sub ---------------- Private Sub ListBox1_Click() ListIdx = ListBox1.ListIndex Namae = ListBox1.List(ListIdx) End Sub 文字数制限の為、一部抜いていま

みんなの回答

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

もし、私の読み違えでないなら、標準モジュールで、VBのアルゴリズムを使いこなしているなら、Office VBAとしては、上級者です。そのような初歩的な質問などするわけないはずですが、ご自身のコードではないのでしょうか?もし、そのコードが読めていないなら、アルゴリズムなどを使わないで、ブラックボックスとして、ワークシート関数やFindメソッドを使ったほうが良いと思うのです。  UserForm_Initializeの中のMax1 が生きていません。  CommandButton1_Clickで、検索して、見つからなかったら、リストボックスには反映しません。  「検索」ユーザー定義関数の中で、MeNamae.ListBox1.Clearしているけれども、その都度、ListBox1のItem をクリアしている。 そのコードでは、リストボックスの役割がはっきりしません。 リストボックスを使う理由は、見つからない文字列を複数の一覧を確認しながら、ワークシートに反映させる、というはずです。 私の理解した範囲では、 テキストボックスに文字を入れる --> ワークシートの列の中のセルを検索 -> 見つからなかったら、リストボックスに表示 -> リストボックスの中の文字列をクリック -> セルに反映 のはずです。 私のコードの読みと理解であっているなら、もっと簡単に、全面的にコードの書き換えたいですね。 なお、Worksheets("2月")は、ActiveSheet だけでも良いはずです。 ** Private Sub CommandButton1_Click()   Dim Namae As String   Dim flg As Boolean   Namae = TextBox1.Text   With ActiveSheet 'または、Worksheets("2月")     If WorksheetFunction.CountIf(.Range("C3", .Cells(Rows.Count, 3).End(xlUp)), Namae) = 0 Then       For i = 0 To ListBox1.ListCount - 1       If ListBox1.List(i) = Trim(Namae) Then Exit For       Next       If i > ListBox1.ListCount - 1 Then         ListBox1.AddItem Namae       Else         MsgBox "'" & Namae & "'は、既にリストボックスに存在しています。", vbInformation       End If     Else       MsgBox "'" & Namae & "'は、既にワークシートには存在しています。", vbInformation     End If   End With   TextBox1.Value = "" End Sub 'LitBox1_Click は、使用中止 'Private Sub ListBox1_Click() '  'End Sub '代わりに、DbleClickイベントにする Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)  Dim i As Integer   For i = 0 To ListBox1.ListCount - 1     If ListBox1.Selected(i) Then        ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1).Value = ListBox1.List(i)        ListBox1.RemoveItem i     End If   Next End Sub

  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.1

一つ簡易な手としては,Listbox1のプロパティでColumnCountを2とかにしておいて,AddItemした際にその2列目に実際のシートの行位置を併せて記録しておくような手もあります。 .ListBox1.AddItem (ListNamae) .ListBox1.List(.listbox1.listcount-1, 1)=i とかでいいのかな? いったいどんな仕込みで一つ一つの追記データを検索してるのか,ちょっとdo loopとか複雑すぎて読み切れません。 選択項目の行位置がこれで判りますから,各テキストボックスに該当行の所定のデータを表示するのもデータをシートに戻すのも,容易に出来ます。

関連するQ&A

  • VBAにてリストボックスに表示された文字をエクセルのセルにコピペするには

    先日、ここで教えてもらった以下の内容で、幾つかのテキストボックスに表示された内容のうち、電話番号をエクセルのセルに転記する方法が、上手くいきません。”検索"名のシート上で実行します。 過去のログを参考にしましたが、解決できませんでした。 またお世話になりますが、だれか教えてください。 Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As UserForm Dim ken As String Namae = TextBox1.Text Set MeNamae = UserForm1 Call 検索(Namae, MeNamae) End Sub Public Sub 検索(ByVal Namae As String, ByRef MeNamae As UserForm) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim kensaku As Worksheet Dim KensakuChar As String Dim ListNamae As String Dim ListChar As String Dim KBanme As Integer Dim LBanme As Integer Set kensaku = Worksheets("顧客データ") MaxRows = kensaku.UsedRange.Rows.Count Nagasa = Len(Namae) MeNamae.ListBox1.Clear For i = 3 To MaxRows ListNamae = kensaku.Cells(i, 3) KBanme = 0 LBanme = 0 Do Do While Nagasa >= KBanme KBanme = KBanme + 1 KensakuChar = Mid(Namae, KBanme, 1) If KensakuChar <> " " Then Exit Do End If Loop Do While Nagasa >= LBanme LBanme = LBanme + 1 ListChar = Mid(ListNamae, LBanme, 1) If ListChar <> " " Then Exit Do End If Loop If KensakuChar = ListChar Then If Nagasa = KBanme Then With MeNamae .ListBox1.AddItem (ListNamae) .ListBox1.List(.ListBox1.ListCount - 1, 1) = i End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub Private Sub ListBox1_Click() Dim r As Long With ListBox1 If .ListIndex > -1 Then r = .List(.ListIndex, 1) '選択した名前の行 TextBox6.Value = Worksheets("顧客データ").Cells(r, 3) 'カタカナ名 TextBox2.Value = Worksheets("顧客データ").Cells(r, 5) '漢字名 TextBox3.Value = Worksheets("顧客データ").Cells(r, 7) '住所 TextBox4.Value = Worksheets("顧客データ").Cells(r, 1) '電話番号 TextBox5.Value = Worksheets("顧客データ").Cells(r, 2) '顧客番号 End If End With End Sub Private Sub CommandButton3_Click() 'クリックすると  Worksheets("検索").Cells(, 2) ’このシートの(G2)に上記の電話番号が入力される End Sub

  • VBAにてリストボックスで選択すると別ブックにあるデータを個別の窓へ表示させるには?

    はじめまして、ゴールデンウィーク中にVBAを勉強していますが、上手くいきません。内容は、「UserForm1を使って別シートにあるデーターから検索を行い、ListBox1に抽出されたリストを選択すると個別のTextBox2に関連する詳細を表示させる」というものです。別シートには「顧客データ」があり、A列より「担当、氏名、カタナカ、住所、電話番号・・・」とデーターが並んでいます。中途半端な状態ですが、これ以上進めません。だれか助けてください。 Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As Object Dim ken As String Namae = TextBox1.Text Set MeNamae = UserForm1 Call 検索(Namae, MeNamae) End Sub '受付画面に検索画面窓を出し、顧客データから検索した結果を出すマクロ Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim kensaku As Object Dim KensakuChar As String Dim ListNamae As String Dim ListChar As String Dim KBanme As Integer Dim LBanme As Integer Set kensaku = Worksheets("顧客データ") MaxRows = kensaku.UsedRange.Rows.Count Nagasa = Len(Namae) MeNamae.ListBox1.Clear For i = 3 To MaxRows ListNamae = kensaku.Cells(i, 3) KBanme = 0 LBanme = 0 Do Do While Nagasa >= KBanme KBanme = KBanme + 1 KensakuChar = Mid(Namae, KBanme, 1) If KensakuChar <> " " Then Exit Do End If Loop Do While Nagasa >= LBanme LBanme = LBanme + 1 ListChar = Mid(ListNamae, LBanme, 1) If ListChar <> " " Then Exit Do End If Loop If KensakuChar = ListChar Then If Nagasa = KBanme Then With MeNamae .ListBox1.AddItem (ListNamae) End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub Private Sub ListBox1_Click() With ListBox1 If .ListIndex > -1 Then TextBox2.Value = .List(.ListIndex, 0)’←これでは何の意味も無い ' TextBox2.Value = kensaku.Cells(kensakuIndex, 3) ' TextBox2.Value = kensaku.Cells(kensaku, 3) ' TextBox2.Text = kokyaku.Hoken4 '      TextBox2.Text = kokyaku.Cells(i, 5) End If End With End Sub

  • EXCEL VBA リストボックスの表示について

    EXCEL VBA リストボックスの表示について Dim rngCell As Range Dim strStr As String Dim strCom As String Dim strId As String UserForm1.ListBox1.Clear strStr = UserForm1.TextBox.text If strStr = "" Then Exit Sub ThisWorkbook.Worksheets("sheet1").Activate For Each rngCell In [a:a] If rngCell.Value Like "*" & strStr & "*" Then If InStr(strCom, rngCell.Value) = 0 Then strCom = rngCell.Offset(0, 5).Value UserForm1.ListBox1.AddItem strCom strCom = "" strId = rngCell.Offset(0, 6).Value UserForm1.ListBox1.AddItem strId strId = "" End If End If Next End Sub 上記のようなコードを作成しました。 キーワードを入力すると決まった行から結果を出力しリストボックスに表示します。 2つの行から結果が出力されるのですがリストボックスの結果表示が上下になってしまいます。 希望としては aaaaa bbbbb と言うように横表示になればと思っています。 &でつなげる方法もありますがリストボックスのColunmWidthsで指定したとおりの間隔で表示させたいと思っています。 どうか助言をお願いいたします。

  • リストボックスのアイテムをマウスで並べ替えたいです

    リストボックスのアイテムをマウスのドラッグドロップで並べ替えたいのですが、 下のような感じで書いてみたのですが、 この状態だと、4番目のものを一番上に持ってくるという動作だけするのですが、 4番目から3番目に移動する場合や、1番目から3番目に移動する場合など 追加していくとIFが重なってきてすごくややこしくなってしまいます。 もっと分かりやすくて合理的な方法がありましたら、 大体でも良いですので、教えて頂けたら助かります。 よろしくおねがいいたします。 Private Sub Form1_Load(...略 ListBox1.Items.Add("AAA") ListBox1.Items.Add("BBB") ListBox1.Items.Add("CCC") ListBox1.Items.Add("EEE") End Sub Private Sub ListBox1_MouseDown(...略 SelectedSortFrom = ListBox1.SelectedIndex End Sub Private Sub ListBox1_MouseUp(...略 SelectedSortTo = ListBox1.SelectedIndex ListBox1Sort(SelectedSortFrom, SelectedSortTo) End Sub Private Function ListBox1Sort(ByVal From As Integer, ByVal Too As Integer) If From = -1 Then Exit Function If Too = -1 Then Exit Function Dim A(ListBox1.Items.Count) As String Dim B As Boolean For i As Integer = 0 To ListBox1.Items.Count - 1 A(i) = ListBox1.Items(i) Next For i As Integer = 0 To ListBox1.Items.Count - 1 If i = Too Then ListBox1.Items(i) = A(From) B = True Else ListBox1.Items(i) = A(i - 1) End If Next End Function

  • リストボックスからの入力をテキストに貼付

    下記コードではリストボックあ行選択しテキスト1~6に入力後、クリアボタンで消去したあと、か行選択しテキストに入力したら7~貼付けになるクリアボタンで消去後、改めてテキスト1~入力するコードがありますか。どなたか解る方よろしくお願いします。 Private Sub 実行_Click() Static cnt As Integer Dim i As Integer If Listbox.ListIndex = -1 Then Exit Sub For i = 0 To Listbox.ListCount - 1 If Listbox.Selected(i) Then cnt = cnt + 1 If cnt > 10 Then cnt = 1 Me.Controls("TextBox" & cnt).Text = Listbox.List(i) End If Next End Sub Private Sub クリア_Click() Dim tbCont As Control With Me.MultiPage1 For Each tbCont In .Pages(.Value).Controls If TypeName(tbCont) = "TextBox" Then tbCont.Value = Null End If Next tbCont End With End Sub

  • VBA リストボックスについて

    VBA初心者です。どうぞよろしくお願いします。 ユーザーフォームにタブつきのリストボックスを作りたいと思っています。 リストはsheet1の中にあります。   A    B    C    D・・・ 1  NO  品名  売場 2  1  いちご  果物 3  2  みかん  果物 4  3  もも    果物 5  4  ハクサイ 野菜 6  5  キャベツ  野菜 7  6  きゅうり  野菜 8  7 9 果物のタブには、果物の品名が表示される。 1 いちご 2 みかん 3 もも 野菜のタブには、野菜の品名が表示される。 4 ハクサイ 5 キャベツ 6 きゅうり 青果のタブには、果物、野菜が表示される。 1 いちご 2 みかん 3 もも 4 ハクサイ 5 キャベツ 6 きゅうり 本を見ながら格闘しておりますが、きっと的違いで滅茶苦茶なことをしているのだと思います。 どうにも出来ず困っております。どなたか教えていただけないでしょうか。よろしくお願いします。 Private Sub UserForm_Initialize() Dim LastRow As Long Dim i As Integer Dim ListBoxNo As Integer Dim ListBox As Control Dim Listtabu(3) As Long 'タブの数 For i = 1 To 3 Listtabu(i) = 0 Next i Worksheets("sheet1").Activate With Worksheets("sheet1") LastRow = .Range("A65536").End(xlUp).Row For i = 2 To LastRow If Worksheets("sheet1").Range(Cells(i, 3)) = "果物" Then ListBoxNo = 1 Set ListBox = 果物 果物.List = Worksheets("sheet1").Range(Cells(i, 1), Cells(i, 2)).Value End If If Worksheets("sheet1").Range(Cells(i, 3)) = "野菜" Then ListBoxNo = 2 Set ListBox = 野菜 野菜.List = Worksheets("sheet1").Range(Cells(i, 1), Cells(i, 2)).Value End If If Worksheets("sheet1").Range(Cells(i, 3)) = "果物" & "野菜" Then ListBoxNo = 3 Set ListBox = 青果 青果.List = Worksheets("sheet1").Range(Cells(i, 1), Cells(i, 2)).Value End If ListBox.AddItem ListBox.List(Listtabu(LstBxNo), 0) = Worksheets("sheet1").Cells(i, 1).Value ListBox.List(Listtabu(LstBxNo), 1) = Worksheets("sheet1").Cells(i, 2).Value Listtabu(LstBxNo) = Listtabu(LstBxNo) + 1 Next End With End Sub

  • リストボックスの内容を テキストファイルに出力

    エクセル vba初心者です。 (1)ini fileからデータを取得 (2)その内容のリストボックスに表示 (3)リストボックス内容をテキストボックスに出力 (2)、(3)がわかりません。 なんとなくやってたら余計にわからなくなりました。助けてください。 Private Sub CommandButton1_Click() '読込み(1)を押した時の処理 Dim listbox As String Dim strL_Data As String '取得した値 Dim n As Integer n = FreeFile    ListBox1.Clear   Open "C:\filepath.ini" For Input As #n Do While Not EOF(n) Line Input #n, listbox ListBox1.AddItem listbox Loop Close #n End Sub Private Sub CommandButton2_Click() '書込み(1)を押した時の処理  Dim listbox As String Dim strL_Data As String '取得した値 Dim n As Integer n = FreeFile    Open "c:\example.txt" For Output As #n Print #n, strL_Data Close #n End Sub よろしくお願いいたします。

  • EXCEL2003 VBA リストボックス

    お世話になります。 質問の内容についてですが、 現在VBAの勉強をしながらデータベースを組んでいます。 そこで、次のようなものを作っています。 Sheet1に於いて、     A    B     C 1  追番  名称   個数 2   1   りんご   1個 3   2   みかん  2個 4   3   なし    3個 5   4   なす    5個 というような表があるとします。 そして、VBAでフォームをつくり、TextBox1(名称入力用)、TextBox2(個数入力用)、ListBox1(すでに入力されているもの及び追加分のリスト用)、CommandButton1(入力された「名称」と「個数」をSheet1の表の一番下に追加)、CommandButton2(フォームを閉じる)という構成にしています。 また、Sheet1上にコマンドボタンを作っており、そのボタンを押すとフォームを呼出すようにしています。 流れとしては、既存の表に追加する場合、コマンドボタンを押してフォームを呼出し、テキストボックスに入力した内容をSheet1の一番下に追加する。また、フォーム上のリストボックスでも現在の表の内容を見る事ができる、というものです。 フォームでのコードは以下のようにしています。 Private Sub CommandButton1_Click() If TextBox1.Value = "" Then MsgBox "「名称」は必須項目です。" End If If TextBox2.Value = "" Then MsgBox "「個数」は必須項目です。" End If If TextBox2.Value = "0" Then MsgBox "「個数」に0は登録できません。" End If Lrow = Range("B2").CurrentRegion.Rows.Count Range("B" & Lrow + 1).Value = TextBox1.Value Range("C" & Lrow + 1).Value = TextBox2.Value End Sub Private Sub CommandButton2_Click() Unload UserForm1 End Sub Private Sub UserForm_Initialize() Dim b As Long Dim a() As String ReDim a(1 To 100) UserForm1.ListBox1.ColumnCount = 2 UserForm1.ListBox1.List = Worksheets(Sheet1).Range("B2:C").Value For i = 2 To 104 If Range("B" & i) = "" Then ListBox1.AddItem Range("B" & i).Value ListBox1.AddItem Range("c" & i).Value b = b + 1 a(b) = Range("C" & i).Value End If Next i End Sub このコードでSheet1上のコマンドボタンを押して実行しようとするとエラーが出てしまいます。 エラーの原因は何なのでしょうか? (なお、コマンドボタンのコードは「UserForm1.Show」のみです。 コード自体は本などを読みながら似たようなVBAを使った物を参考にしています。

  • エクセルマクロ_上書き(リストボックスでデータを抽出し、その行へ上書き)

    エクセルマクロ初心者です。(2003使用_ユーザーフォーム,リストボックス,テキストボックス,チャックボックス) Sheet1のデータをユーザーフォームへ反映させ、修正したものをその行へ上書きするマクロを作成したいと思っていますが、うまくいかないのでどなたかお教え願います。 (Sheet1―A8より表がはじまります) 管理番号 品名 数量 希望納期 変更数量 完納 コメント アカ12 みかん     40   8月3日 アオ35 りんご     30   8月5日 クロ54 なし     50   7月7日 アカ98 もも     20   9月1日 アオ43 すいか     35   8月3日 ●完納の行がチャックボックスで、チェックがついたら、”完納”と記載、チェックがついていなかったら空欄のまま。もし表に”完納”と記載されていたら、コマンドボタン1でデータを抽出した時に、チェックがつくようにしたいのです。が、まったくうまくいかないのです。 ●また、コマンド1での抽出データに値を入力したものを上書きすることは一部できるのですが、空欄にしたときに、空欄の状態(無記入)に上書きすることができません。 Private Sub UserForm_Initialize() Dim r As Range Set r = Sheets("Sheet1").Range("A8").CurrentRegion.Offset(1) Set r = r.Resize(r.Rows.Count - 1) With ListBox1 .ColumnWidths = "50;50;0;0;0;0;0" .ColumnCount = 7 .RowSource = r.Address(A8, G) End With End Sub Private Sub CommandButton1_Click() If ListBox1.ListIndex <> -1 Then TextBox1.Value = ListBox1.List(ListBox1.ListIndex, 0) TextBox2.Value = ListBox1.List(ListBox1.ListIndex, 1) TextBox3.Value = ListBox1.List(ListBox1.ListIndex, 2) TextBox5.Value = ListBox1.List(ListBox1.ListIndex, 4) TextBox6.Value = ListBox1.List(ListBox1.ListIndex, 6) End If If Not IsEmpty(ListBox1.List(ListBox1.ListIndex, 3)) Then TextBox4.Value = Format(CDate(ListBox1.List(ListBox1.ListIndex, 3)), "m/d") Else TextBox4.Value = "" End If End Sub Private Sub CommandButton2_Click() If ListBox1.ListIndex <> -1 Then Dim r As Range ' 元データの範囲を取得 Set r = Sheets("Sheet1").Range("A8").CurrentRegion.Offset(1) Set r = r.Resize(r.Rows.Count - 1) ' 日付型かどうかをチェック If IsDate(TextBox4.Value) Then ' 選択されたセルの更新 r(ListBox1.ListIndex + 1, 4) = TextBox4.Value End If r(ListBox1.ListIndex + 1, 7) = TextBox6.Value End If End Sub Private Sub CheckBox1_Click() If ListBox1.ListIndex <> -1 Then Dim l As Range Set l = Sheets("Sheet1").Range("A8").CurrentRegion.Offset(1) Set l = l.Resize(l.Rows.Count - 1) If CheckBox1.Value = True Then l(ListBox1.ListIndex + 1, 5).Value = "完納" If CheckBox1.Value = False Then l(ListBox1.ListIndex + 1, 5).Value = "<>" End If End If End If End Sub すみませんが、ご親切に教えていただけましたら幸いです。 よろしくお願いいたします。

  • Excel マクロ リストボックス複数選択

    いろいろ拝見させていただいているのですが 理解が低いのが原因で困っています。 データのシートがあります。 ・B列には、起点となる人の名前が記載(300名ほど) ・データの入っている列は、A:CE データシートでB列にてオートフィルタをかけ 抽出シートに転記したい。 抽出シートでは、ユーザーフォームを組みました。 オプションボタン1 単一選択 オプションボタン2 複数選択 オプションボタン3 拡張選択 リストボックス(2・3に対して) コマンドボタン   終了 とした場合、単一選択はできたのですが 複数選択の場合 該当数が「0」の表記となってしまい、うまくいきません。 同じような質問が…というお返事があることを承知でお伺いしています。 いただいた回答を基に、勉強をしていきたいと思っていますので なにとぞよろしくお願い申し上げます。 Private Sub UserForm_Initialize() ListBox1.ColumnCount = 1 'リストボックスの列は1 ListBox1.BoundColumn = 0 'ListIndexの値(行数)を使用する ListBox1.MultiSelect = 0 '最初は単一選択状態にする ListBox1.RowSource = 'リストのソース ListBox1.ColumnHeads = True '列見出し表示 OptionButton1.Value = -1 'オプションボタン1を選択状態にする End Sub Private Sub OptionButton1_Click() ListBox1.MultiSelect = fmMultiSelectSingle '単一選択状態にする End Sub Private Sub OptionButton2_Click() ListBox1.MultiSelect = fmMultiSelectMulti '複数選択状態にする End Sub Private Sub OptionButton3_Click() ListBox1.MultiSelect = fmMultiSelectExtended '拡張(連続)選択状態にする End Sub Private Sub ListBox1_Click() 'リストボックスがクリックされたとき(単一選択) Dim 条件 As String 条件 = UserForm1.ListBox1.Text '氏名 With Worksheets("データ") .Range("A1").AutoFilter _ field:=2, Criteria1:=条件 .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _ Worksheets("抽出").Range("A1") .Range("A1").AutoFilter End With End Sub Private Sub CommandButton1_Click() '選択終了ボタンがクリックされたとき(複数・拡張選択) Dim 条件 As String Dim lastRow As Long With ListBox1 If .ListIndex = -1 Then Exit Sub '何も選択されていない For 条件 = 0 To .ListCount - 1 If .Selected(条件) Then '行選択あり With Worksheets("データ") .Range("A1").AutoFilter _ field:=2, Criteria1:=条件 .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _ Worksheets("抽出").Range("A1") .Range("A1").AutoFilter End With End If Next End With End Sub Private Sub UserForm_Deactivate() Unload UserForm1 '×ボタンを押したら、ユーザーフォームのunloadをする End Sub

専門家に質問してみよう