Excel VBA質問箱 IV

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

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


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

3507 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

▼

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

【61773】Re:LISTBOX代入 つん 09/6/3(水) 11:32

【61774】Re:LISTBOX代入 つん 09/6/3(水) 11:37

【61777】Re:LISTBOX代入 Yuki 09/6/3(水) 13:22


	【61768】LISTBOX代入

LIO - 09/6/3(水) 7:46 -


	引用なし

	パスワード

お世話になります。
下記のようにシート1にて表があります。
A B　　C　 D
1 東京 100
2 埼玉 500
3 埼玉 300
1 群馬 100
1 東京 300
2 埼玉 400
ユーザーフォームにて
ComboBox1とLixtBox1を作成し
A列の値をcombobox1に選択した場合
ListBox1にその値に等しい行の値がすべて入るようにしたいと思います
例
ComboBox1に1を選択した場合
Listbox1には
1 東京 100
1 群馬 100
1 東京 300

のように表示させたいと思っております。
また実際のシート1には1000行20列程のデータが記載されております。
ご面倒をおかけいたしますが宜しくお願いいたします。


	【61773】Re:LISTBOX代入

つん - 09/6/3(水) 11:32 -


	引用なし

	パスワード

▼LIO さん
こんにちは

もっと効率がいいやり方があるかと思いますが、
とりあえず、作ってみたら出来たので（みたい・・・）
というレベルなんですが、よかったらお試し下さいませ。

'==============================================
Private Sub UserForm_Initialize()
　　
　　Dim i As Long

　　With ComboBox1
　　　　For i = 1 To 3　’とりあえずＡ列の値が「３」までとして
　　　　　　.AddItem i
　　　　Next i
　　　　.Style = fmStyleDropDownList
　　End With
　　
　　
　　With ListBox1
　　　　.ColumnCount = 3
　　　　.ColumnWidths = "30,60,60"
　　End With

End Sub

'==============================================
Private Sub ComboBox1_Change()

　　Dim lngNO As Long
　　Dim i As Long
　　Dim ws As Worksheet
　　Dim ArData()
　　Dim k As Long
　　
　　With Worksheets("Sheet1")
　　
　　　　lngNO = ComboBox1.Value
　　　　k = 0
　　　　For i = 1 To Range("a65536").End(xlUp).Row
　　　　　　If Cells(i, 1).Value = lngNO Then
　　　　　　ReDim Preserve ArData(3, k)
　　　　　　　　ArData(0, k) = Cells(i, 1).Value
　　　　　　　　ArData(1, k) = Cells(i, 2).Value
　　　　　　　　ArData(2, k) = Cells(i, 3).Value
　　　　　　　　k = k + 1
　　　　　　End If　　　　　　
　　　　Next i
　　End With

　　ListBox1.Column() = ArData
　　　
　　Erase ArData
End Sub

'==============================================

配列の扱い、こんなんでいいのかな・・・・

と、ここまでかいて気がついた
＞また実際のシート1には1000行20列程のデータが記載されております
そんなデータ量だったら、こんなやり方はダメなんかなあ・・・・


	【61774】Re:LISTBOX代入

つん - 09/6/3(水) 11:37 -


	引用なし

	パスワード

あ、

>　ArData(0, k) = Cells(i, 1).Value
>　ArData(1, k) = Cells(i, 2).Value
>　ArData(2, k) = Cells(i, 3).Value

この部分

　　Dim h As Long

　　For h = 0 To 2
　　　　ArData(h, k) = Cells(i, h + 1).Value
　　Next h

とかしたら、列が多くても大丈夫かなｗ


	【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


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

3507 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free