Excel VBA質問箱 IV

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

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


3509 / 13646 ツリー ←次へ | 前へ→

【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 ’とりあえずA列の値が「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

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

【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

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