Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

20380 / 76736

←次へ　｜　前へ→


	【61777】Re:LISTBOX代入

Yuki - 09/6/3(水) 13:22 -


	引用なし

	パスワード

▼LIO さん：
>ユーザーフォームにて
>ComboBox1とLixtBox1を作成し
>A列の値をcombobox1に選択した場合
>ListBox1にその値に等しい行の値がすべて入るようにしたいと思います
>例
>ComboBox1に1を選択した場合
>Listbox1には
>1 東京 100
>1 群馬 100
>1 東京 300
>
>のように表示させたいと思っております。
>また実際のシート1には1000行20列程のデータが記載されております。
>ご面倒をおかけいたしますが宜しくお願いいたします。

こんにちは。
AdvancedFilterを使ってみました。
ワーク用にWorkというシートを追加しています。

Private Sub ComboBox1_Change()
　　Dim i　 As Long
　　Dim ws　As Worksheet
　　Set ws = Worksheets("Work")
　　ws.Cells.ClearContents
　　With Worksheets("Sheet1")
　　　　ws.Range("G1").Value = .Range("A1").Value
　　　　ws.Range("G2").Value = Me.ComboBox1.Value
　　　　ws.Range("I1").CurrentRegion.ClearContents
　　　　.Range("A1").CurrentRegion.AdvancedFilter _
　　　　　　　　　　　　Action:=xlFilterCopy, _
　　　　　　　　　　　　CriteriaRange:=ws.Range("G1:G2"), _
　　　　　　　　　　　　CopyToRange:=ws.Range("I1"), Unique:=False
　　　　Me.ListBox1.Clear
　　　　With ws.Range("I1").CurrentRegion
　　　　　　Me.ListBox1.List = .Offset(1).Resize(.Rows.Count - 1).Value
　　　　End With
　　End With
End Sub

Private Sub UserForm_Initialize()
　　Dim Dic As Object
　　Dim v　 As Variant
　　Dim i　 As Long
　　Dim f　 As Boolean
　　
　　Set Dic = CreateObject("Scripting.Dictionary")
　　v = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
　　For i = 2 To UBound(v)
　　　　Dic(v(i, 1)) = Empty
　　Next
　　v = Dic.Keys
　　Me.ComboBox1.List = v
　　
　　For i = 1 To Worksheets.Count
　　　　If Worksheets(i).Name = "Work" Then
　　　　　　f = True
　　　　　　If Worksheets(i).Visible = xlSheetVisible Then
　　　　　　　　Worksheets(i).Visible = xlSheetHidden
　　　　　　End If
　　　　　　Exit For
　　　　End If
　　Next
　　If Not f Then
　　　　With Worksheets.Add
　　　　　　.Name = "Work"
　　　　　　.Visible = xlSheetHidden
　　　　End With
　　End If
End Sub

0 hits

▼

【61768】LISTBOX代入 LIO 09/6/3(水) 7:46