Excel VBA質問箱 IV

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

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


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

【63578】ListBoxに個数を更新表示 tk 09/11/18(水) 21:21 質問[未読]
【63580】Re:ListBoxに個数を更新表示 tk 09/11/18(水) 21:43 発言[未読]
【63584】Re:ListBoxに個数を更新表示 ichinose 09/11/19(木) 6:19 発言[未読]
【63592】Re:ListBoxに個数を更新表示 tk 09/11/19(木) 21:00 お礼[未読]
【63587】Re:ListBoxに個数を更新表示 Yuki 09/11/19(木) 10:40 発言[未読]
【63588】Re:ListBoxに個数を更新表示 Yuki 09/11/19(木) 11:04 発言[未読]
【63593】Re:ListBoxに個数を更新表示 tk 09/11/19(木) 21:08 お礼[未読]

【63578】ListBoxに個数を更新表示
質問  tk  - 09/11/18(水) 21:21 -

引用なし
パスワード
   ListBoxをクリックしてセルに値を入力して、ListBoxに入力個数を
更新表示しょうと思っています。
ところがListBoxをクリックして値を入力すると、ListBoxが
真っ白になってしまいます。更新表示できるようにするにはどうす
ればよいでしょうか。

UserForm1モジュール
Private Sub ListBox1_Click()
  ActiveCell.Value = Me.ListBox1.Text
  Set_list
  DoEvents
  Application.Visible = True
End Sub

Private Sub UserForm_Initialize()
  With Me.ListBox1
    .ColumnCount = 2
    .ColumnWidths = "30;30"
    .TextColumn = 1
  End With
  Set_list
End Sub

Sub Set_list()
Dim a
Dim dic   As Object
Dim myRange As Range, r As Range
 
  Set dic = CreateObject("Scripting.Dictionary")
  ReDim a(1)
  dic("コマ") = "個数"
  Set myRange = Range("a1:z30")
  For Each r In myRange
    If r.Text <> "" Then
      dic(r.Text) = Application.CountIf(myRange, r.Text) 'key別個数
    End If
  Next

  '-----個数出力
  With UserForm1.ListBox1
    .Clear
    .List = Application.Transpose(Array(dic.keys, dic.Items))
  End With
  Set dic = Nothing
End Sub

【63580】Re:ListBoxに個数を更新表示
発言  tk  - 09/11/18(水) 21:43 -

引用なし
パスワード
   Set_list はこのようにした方がわかりやすいので訂正します。

>UserForm1モジュール
>Private Sub ListBox1_Click()
>  ActiveCell.Value = Me.ListBox1.Text
>  Set_list
>  DoEvents
>  Application.Visible = True
>End Sub
>
>Private Sub UserForm_Initialize()
>  With Me.ListBox1
>    .ColumnCount = 2
>    .ColumnWidths = "30;30"
>    .TextColumn = 1
>  End With
>  Set_list
>End Sub
>
>Sub Set_list()
>Dim a
>Dim dic   As Object
>Dim myRange As Range, r As Range
> 
>  Set dic = CreateObject("Scripting.Dictionary")
>  ReDim a(1)
>  dic("コマ") = "個数"
  For i = 0 To 10
    dic(Chr(Asc("a") + i)) = 0  'コマ
  Next
>  Set myRange = Range("a1:z30")
>  For Each r In myRange
>    If r.Text <> "" Then
>      dic(r.Text) = Application.CountIf(myRange, r.Text) 'key別個数
>    End If
>  Next
>
>  '-----個数出力
>  With UserForm1.ListBox1
>    .Clear
>    .List = Application.Transpose(Array(dic.keys, dic.Items))
>  End With
>  Set dic = Nothing
>End Sub

【63584】Re:ListBoxに個数を更新表示
発言  ichinose  - 09/11/19(木) 6:19 -

引用なし
パスワード
   ▼tk さん:
おはようございます。
Excel2002で確認しました。
リストボックスのクリックイベントを滅多に使わないので初めて知りました。
ちょこっと弄ってみたけど、クリックイベントでの簡単な修正方法は見つかりませんでした。

ただ、リストボックスのクリックイベントでリストボックスの書換えをするのではなく、
もう一つコマンドボタンを設けて、そのクリックイベントで

>>Private Sub ListBox1_Click()
>>  ActiveCell.Value = Me.ListBox1.Text
>>  Set_list
>>  DoEvents
>>  Application.Visible = True
>>End Sub

この内容を実行すれば、正常に作動します。

どうしてもリストボックスのクリックイベントがいいなら・・・、
動的にリストボックスを作成して、書換えは、リストボックスを再作成して行なう方法です。


新規ブックにて試してください。

ユーザーフォームを一つ作成してください。
中のコントロールは、コードで作成しますから、何も配置しないでください。

そのユーザーフォーム(UserForm1)のモジュールに

'===================================================================
Option Explicit
Private WithEvents ll As MSForms.ListBox
'===================================================================
Private Sub ll_Click()
  ActiveCell.Value = ll.Text
  Controls.Remove 2
  Set ll = mk_listbox
  Set_list ll
End Sub
'===================================================================
Private Sub UserForm_Initialize()
  With Me
    .Width = 216
    .Height = 326
  End With
  With Controls.Add("Forms.Label.1", , True)
    .Left = 18
    .Top = 30
    .Width = 81
    .Height = 18
    .SpecialEffect = 2
    .BackColor = &HFFFF&
    .TextAlign = 2
    .Font.Size = 14
    .Caption = "コマ"
   End With
  With Controls.Add("Forms.Label.1", , True)
    .Left = 100
    .Top = 30
    .Width = 81
    .Height = 18
    .SpecialEffect = 2
    .BackColor = &HFFFF00
    .TextAlign = 2
    .Font.Size = 14
    .Caption = "個数"
   End With
  Set ll = Controls.Add("Forms.ListBox.1", , True)
  With ll
    .Left = 18
    .Top = 54
    .Width = 165
    .Height = 216
    .ColumnCount = 2
    .TextColumn = 1
    .TextAlign = 2
  End With
  Set ll = mk_listbox
  Set_list ll
End Sub
'===================================================================
Sub Set_list(lll As MSForms.ListBox)
  Dim i As Long
  Dim dic   As Object
  Dim myRange As Range
  Dim r As Variant
  Set dic = CreateObject("Scripting.Dictionary")
  ReDim a(1)
  For i = 0 To 10
    dic(Chr(Asc("a") + i)) = 0
  Next
  Set myRange = Range("a1:z30")
  For Each r In dic.keys
     dic(r) = Application.CountIf(myRange, r)
  Next
  With lll
    .List = Application.Transpose(Array(dic.keys, dic.Items))
  End With
  Set dic = Nothing
End Sub
'===================================================================
Function mk_listbox() As MSForms.ListBox
  Set mk_listbox = Controls.Add("Forms.ListBox.1", , True)
  With mk_listbox
    .Left = 18
    .Top = 54
    .Width = 165
    .Height = 216
    .ColumnCount = 2
    .TextColumn = 1
    .TextAlign = 2
  End With
End Function


標準モジュールに

'=============================================================
Sub test()
  With Range("a1:z30")
    .Formula = "=CHAR(RANDBETWEEN(97,107))"
    .Value = .Value
  End With
  UserForm1.Show vbModeless
End Sub


これで、testを実行して試してみてください。

【63587】Re:ListBoxに個数を更新表示
発言  Yuki  - 09/11/19(木) 10:40 -

引用なし
パスワード
   ▼tk さん:
こんにちは。

Set_listの一部を変更して
標準モジュールに
変数とListSetを追加してみてください。

>>Sub Set_list()
>>Dim a
>>Dim dic   As Object
>>Dim myRange As Range, r As Range
>> 
>>  Set dic = CreateObject("Scripting.Dictionary")
>>  ReDim a(1)
>>  dic("コマ") = "個数"
>  For i = 0 To 10
>    dic(Chr(Asc("a") + i)) = 0  'コマ
>  Next
>>  Set myRange = Range("a1:z30")
>>  For Each r In myRange
>>    If r.Text <> "" Then
>>      dic(r.Text) = Application.CountIf(myRange, r.Text) 'key別個数
>>    End If
>>  Next
' ********************************************
  v1 = dic.keys
  v2 = dic.items
  Set dic = Nothing
  
  '-----個数出力
  Application.OnTime Now(), "ListSet"
' ********************************************
>>End Sub

標準モジュールに
Option Explicit
Public v1  As Variant
Public v2  As Variant

Public Sub ListSet()
  With UserForm1.ListBox1
    .Clear
    .List = Application.Transpose(Array(v1, v2))
  End With
End Sub

【63588】Re:ListBoxに個数を更新表示
発言  Yuki  - 09/11/19(木) 11:04 -

引用なし
パスワード
   >▼tk さん:
こんにちは。
>
>Set_listの一部を変更して
>標準モジュールに
>変数とListSetを追加してみてください。
>

というより
Set_listをそっくり標準モジュールに移動して
Set_listの呼び出しを
Application.OnTime Now(), "Set?list"
で良いですね。

>Sub Set_list()
>Dim a
>Dim dic   As Object
>Dim myRange As Range, r As Range
> 
>  Set dic = CreateObject("Scripting.Dictionary")
>  ReDim a(1)
>  dic("コマ") = "個数"
  For i = 0 To 10
>    dic(Chr(Asc("a") + i)) = 0  'コマ
>  Next
>  Set myRange = Range("a1:z30")
>  For Each r In myRange
>    If r.Text <> "" Then
>      dic(r.Text) = dic(r.Text) + 1 'key別個数
>    End If
>  Next

>  With UserForm1.ListBox1
>    .Clear
>    .List = Application.Transpose(Array(Dic.keys, Dic.items))
>  End With
>End Sub

【63592】Re:ListBoxに個数を更新表示
お礼  tk  - 09/11/19(木) 21:00 -

引用なし
パスワード
   ▼ichinose さん、今晩は。

リストボックスのクリックイベントをつかいたいので

>動的にリストボックスを作成して、書換えは、リストボックスを再作成して行なう方法です。

の方法でうまくできました。

解答ありがとうございます。

【63593】Re:ListBoxに個数を更新表示
お礼  tk  - 09/11/19(木) 21:08 -

引用なし
パスワード
   ▼Yuki さん、今晩は。

>Set_listをそっくり標準モジュールに移動して
>Set_listの呼び出しを
>Application.OnTime Now(), "Set?list"
>で良いですね。

この方法は簡単でいいですね。
うまく動くのを確認できました。

解答ありがとうございました。

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