Excel VBA質問箱 IV

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

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


20376 / 76732 ←次へ | 前へ→

【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 発言
【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 発言

20376 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free