[[20161226014041]]　『ListBoxの代わりにListViewに表示させるには』（take）　ページの最後に飛ぶ

『ListBoxの代わりにListViewに表示させるには』（take）

現在データをUFのListBoxに下記コードにて候補表示していますが
件数が増えマウススクロールが利用できるListViewに書き換えるには
どのようにすれば可能でしょうか

候補表示の概要説明は以下です。
1.X列　5行目から最下行は不特定
2.同一名称は、１つとし重複は省く（空白(未入力)は無視）
　順番はX5から下へ入力順でかまいません。(ソートの必要なし)

ListView側の準備も含め

よろしくお願いします

Private Sub UserForm_Activate()

    With ListView1
        'プロパティ
        .View = lvwReport 
        .LabelEdit = lvwManual  
        .HideSelection = False
        .AllowColumnReorder = True
        .FullRowSelect = True
        .Gridlines = True 
        ''列見出し
        .ColumnHeaders.Add , "_List", "社名", 150’1列
     End With

Private Sub UserForm_Initialize()

    Dim c As Object
    Dim r As Range
    Dim t As Range
    If Cells(5, 24).Value <> "" Then
        Set c = CreateObject("Scripting.Dictionary")
        Set t = Range("X5", Cells(Rows.Count, "X").End(xlUp))
        On Error Resume Next
        For Each r In t
            c.Add r.Value, 0
        Next
        On Error GoTo 0
        Me.ListBox1.List = c.keys
    Else
        MsgBox "データがありません", vbExclamation
        Me.ListBox1.AddItem "デフォルト値"
    End If
    ListBox1.ListIndex = Worksheets("見積").Range("AC1").Value

End Sub

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

こんにちは

UserForm_Initializeの方を修正して、

Private Sub UserForm_Initialize()

    Dim c As Object
    Dim r As Range
    Dim t As Range
    Dim k As Variant
    If Cells(5, 24).Value <> "" Then
        Set c = CreateObject("Scripting.Dictionary")
        Set t = Range("X5", Cells(Rows.Count, "X").End(xlUp))
        On Error Resume Next
        For Each r In t
            c.Add r.Value, 0
        Next
        On Error GoTo 0
        With Me.ListView1
            .ListItems.Clear
            For Each k In c.keys
                With .ListItems.Add
                    .Text = k
                End With
            Next
            If .ListItems.Count > 0 Then .ListItems(1).Selected = True
        End With
    Else
        MsgBox "データがありません", vbExclamation
    End If
End Sub

（ウッシ） 2016/12/26(月) 09:21

（ウッシ）さん
ありがとうございます。
UserForm_Initialize修正しListView1変更して実行してみましたが
複数列にバラバラにリスト項目が表示されてしまいました。
１行づつ表示させたいのですが
ほか、変更するような箇所はありますか？

よろしくお願いします
（take） 2016/12/26(月) 10:40

こんにちは

Private Sub UserForm_Activate()

    With ListView1
        'プロパティ
        .View = lvwReport 
        .LabelEdit = lvwManual  
        .HideSelection = False
        .AllowColumnReorder = True
        .FullRowSelect = True
        .Gridlines = True 
        ''列見出し
        .ColumnHeaders.Add , "_List", "社名", 150’1列
     End With

End Sub

の方はそのままにしてありますか？

（ウッシ） 2016/12/26(月) 11:22

（ウッシ）さん
ありがとうございます。
大変失礼しました　うまくいきましたが、やはり表示件数が多いため
リストが多くなってしまったため候補から探し出すのがちょっと時間が
かかります。

依って最初の条件を変更したいのですが
リスト内に（会社名が殆どです）(株)○○、○○（株）など
半角カッコや全角カッコなど（当然ですが(有)も存在します。）

この末尾の(株)は問題ないと思いますがあたま(株)はのぞき
（ソート時のみ、表示は(株)ついたままでOKです）
50音順に、表示させられないでしょうか

何度も申し訳ないのですがお知恵お貸しください。
よろしくお願いします。
記入のある社名は以下です。
○○(株)
○△（株）
□□（有）
?梶?○（機種依存の株です）
(株)○○
（株）○▲
(有)◇○
（有）□△

空白行
などです。

（take） 2016/12/26(月) 12:27

ListViewにソート機能はありますが、

＞50音順に、表示させられないでしょうか
50音順なら振り仮名の情報が欲しいかも？

Option Explicit

Private Sub UserForm_Initialize()

    With ListView1
        .View = lvwReport           ''表示
        .LabelEdit = lvwManual      ''ラベルの編集
        .HideSelection = False      ''選択の自動解除
        .AllowColumnReorder = True  ''列幅の変更を許可
        .FullRowSelect = True       ''行全体を選択
        .Gridlines = True           ''グリッド線
        .ColumnHeaders.Add , "_Name", "名前", 150    '1列
    End With

    Reset_ListView
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

    With ListView1
        .SortKey = ColumnHeader.Index - 1
        .SortOrder = .SortOrder Xor lvwDescending
        .Sorted = True
    End With
End Sub

Sub Reset_ListView()

    Dim rngT As Range
    Dim rngB As Range
    Dim c As Range
    Dim i As Long

    With Sheets(1)
        Set rngT = .Cells(5, "X")
        Set rngB = .Cells(.Rows.Count, "X").End(xlUp)
    End With

    With Me.ListView1.ListItems
        If rngT.Row <= rngB.Row Then
            For Each c In Range(rngT, rngB)
                If c.Value <> Empty Then
                    On Error Resume Next
                    .Add Key:=c.Value, Text:=c.Value
                    On Error GoTo 0
                End If
            Next
        End If
        If .Count = 0 Then .Add Text:="デフォルト値"

        For i = 1 To .Count
            If .Item(i).Key = Sheets(1).Range("AC1").Value Then
                .Item(i).Selected = True
                Exit For
            End If
        Next
    End With
End Sub

あぁ、最初に昇順1回なら、アイテムを追加するときに
上手く並べ替えてもいけるかもですが、
アルゴリズムとか知らないとつらいですかね。。。

リストビューも自分で調べられんと、手取り足取り全部をっていうわけにもならんだろうから、
結構つらいかもですねー。。。

参考URL>>
http://officetanaka.net/excel/vba/listview/index.htm

（まっつわん） 2016/12/26(月) 13:27

（まっつわん）さん
ありがとうございます。
参考URL>>
確認しました。
う～、かなり難しいですね・・・
サンプル頂きましたコードですが
ソートしてないようです。残念です

＞あぁ、最初に昇順1回なら、アイテムを追加するときに
＞上手く並べ替えてもいけるかもですが、
＞アルゴリズムとか知らないとつらいですかね。。。
アルゴリズム？解らないですね　つらい
＞最初に昇順1回なら、
　↑これの意味はどういうことでしょうか
ユーザーフォーム起動はX列ダブルクリックで行っています。

（take） 2016/12/26(月) 14:19

＞↑これの意味はどういうことでしょうか

↑は、

.Add Key:=c.Value, Text:=c.Value

のところでインデックス番号も指定できるようなので、
次に何番目に挿入すればいいかがわかれば、
昇順に並ぶであろうという話しです。

＞ソートしてないようです。残念です
ヘッダーを1回クリックで昇順/降順に切り替わるはずですが。。。。
(株)とかの記号は別にして。。。

非表示の列に振り仮名情報を入れておけば、
希望する並べ替えが出来ると思います。

＞参考URL>>
＞確認しました。
＞う～、かなり難しいですね・・・
書いてあることが難しければ、
書いてないことを探るのはもっと難しいかと。。。

気長に研究出来ればいいのでしょうが、
モチベーションが続くかどうか。。。

ListViewはヘルプが使えないので、
オブジェクトブラウザでみたり、
ネットで他言語の解説とか見て想像するかくらいしか、
探る方法が思いつかないので、
初心者では厳しいかと思います。
まぁ、掲示板でしつこく聞くくらいしかできんとを思うけど、
詳しい人が掲示板で回答してるとは限らないので。。。＾＾；

（まっつわん） 2016/12/26(月) 14:35

こんにちは

Private Sub UserForm_Activate()
・・・
End Sub

は削除して貰って、

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

    With ListView1
        .SortKey = ColumnHeader.Index - 1
        .SortOrder = .SortOrder Xor lvwDescending
        .Sorted = True
    End With
End Sub

は、まっつわんさんのをお借りして、

Private Sub UserForm_Initialize()

    Dim r As Range
    Dim t As Range
    Dim k As Variant
    With ListView1
        'プロパティ
        .View = lvwReport
        .LabelEdit = lvwManual
        .HideSelection = False
        .AllowColumnReorder = True
        .FullRowSelect = True
        .Gridlines = True
        ''列見出し
        .ColumnHeaders.Add , "_List", "社名", 150 '1列
        .ColumnHeaders.Add , "_Kana", " かな名", 150 '1列
    End With
    If Cells(5, 24).Value <> "" Then
        Set t = Range("X5", Cells(Rows.Count, "X").End(xlUp))

        With Me.ListView1
            .ListItems.Clear
            On Error Resume Next
            For Each r In t
                With .ListItems.Add
                    .Key = r.Value
                    .Text = r.Value
                    .SubItems(1) = Application.GetPhonetic(法人格抜き(r.Value))
                End With
            Next
            On Error GoTo 0
            If .ListItems.Count > 0 Then .ListItems(1).Selected = True
        End With
    Else
        MsgBox "データがありません", vbExclamation
    End If
End Sub

Function 法人格抜き(s As String) As Variant

    s = Replace(s, "特定非営利活動法人", "")
    s = Replace(s, "（公益社団法人）", "")
    s = Replace(s, "（社会福祉法人）", "")
    s = Replace(s, "（農事組合法人）", "")
    s = Replace(s, "（医療法人財団）", "")
    s = Replace(s, "（医療法人社団）", "")
    s = Replace(s, "社会福祉法人）", "")
    s = Replace(s, "農事組合法人）", "")
    s = Replace(s, "医療法人財団）", "")
    s = Replace(s, "医療法人社団）", "")
    s = Replace(s, "（社会福祉法人", "")
    s = Replace(s, "（農事組合法人", "")
    s = Replace(s, "（医療法人財団", "")
    s = Replace(s, "（医療法人社団", "")
    s = Replace(s, "商工組合連合会", "")
    s = Replace(s, "協同組合連合会", "")
    s = Replace(s, "（森林組合）", "")
    s = Replace(s, "（生産組合）", "")
    s = Replace(s, "（宗教法人）", "")
    s = Replace(s, "（学校法人）", "")
    s = Replace(s, "(企業組合)", "")
    s = Replace(s, "（財団法人）", "")
    s = Replace(s, "（社団法人）", "")
    s = Replace(s, "（医療法人）", "")
    s = Replace(s, "（協同組合）", "")
    s = Replace(s, "（相互会社）", "")
    s = Replace(s, "（合名会社）", "")
    s = Replace(s, "（合資会社）", "")
    s = Replace(s, "（有限会社）", "")
    s = Replace(s, "（株式会社）", "")
    s = Replace(s, "社会医療法人", "")
    s = Replace(s, "公益社団法人", "")
    s = Replace(s, "社会福祉法人", "")
    s = Replace(s, "農事組合法人", "")
    s = Replace(s, "医療法人財団", "")
    s = Replace(s, "医療法人社団", "")
    s = Replace(s, "（医財団）", "")
    s = Replace(s, "（医社団）", "")
    s = Replace(s, "森林組合）", "")
    s = Replace(s, "生産組合）", "")
    s = Replace(s, "宗教法人）", "")
    s = Replace(s, "学校法人）", "")
    s = Replace(s, "(企業組合", "")
    s = Replace(s, "財団法人）", "")
    s = Replace(s, "社団法人）", "")
    s = Replace(s, "医療法人）", "")
    s = Replace(s, "協同組合）", "")
    s = Replace(s, "相互会社）", "")
    s = Replace(s, "合名会社）", "")
    s = Replace(s, "合資会社）", "")
    s = Replace(s, "有限会社）", "")
    s = Replace(s, "株式会社）", "")
    s = Replace(s, "ＮＰＯ法人", "")
    s = Replace(s, "（森林組合", "")
    s = Replace(s, "（生産組合", "")
    s = Replace(s, "（宗教法人", "")
    s = Replace(s, "（学校法人", "")
    s = Replace(s, "企業組合)", "")
    s = Replace(s, "（財団法人", "")
    s = Replace(s, "（社団法人", "")
    s = Replace(s, "（医療法人", "")
    s = Replace(s, "（協同組合", "")
    s = Replace(s, "（相互会社", "")
    s = Replace(s, "（合名会社", "")
    s = Replace(s, "（合資会社", "")
    s = Replace(s, "（有限会社", "")
    s = Replace(s, "（株式会社", "")
    s = Replace(s, "（医財）", "")
    s = Replace(s, "（医社）", "")
    s = Replace(s, "医財団）", "")
    s = Replace(s, "医社団）", "")
    s = Replace(s, "（医財団", "")
    s = Replace(s, "（医社団", "")
    s = Replace(s, "（社福）", "")
    s = Replace(s, "（社団）", "")
    s = Replace(s, "特殊法人", "")
    s = Replace(s, "合同会社", "")
    s = Replace(s, "森林組合", "")
    s = Replace(s, "生産組合", "")
    s = Replace(s, "宗教法人", "")
    s = Replace(s, "学校法人", "")
    s = Replace(s, "企業組合", "")
    s = Replace(s, "監査法人", "")
    s = Replace(s, "財団法人", "")
    s = Replace(s, "社団法人", "")
    s = Replace(s, "医療法人", "")
    s = Replace(s, "商工組合", "")
    s = Replace(s, "共済組合", "")
    s = Replace(s, "協業組合", "")
    s = Replace(s, "協同組合", "")
    s = Replace(s, "労働金庫", "")
    s = Replace(s, "信用組合", "")
    s = Replace(s, "信用金庫", "")
    s = Replace(s, "相互会社", "")
    s = Replace(s, "合名会社", "")
    s = Replace(s, "合資会社", "")
    s = Replace(s, "有限会社", "")
    s = Replace(s, "株式会社", "")
    s = Replace(s, "医財）", "")
    s = Replace(s, "医社）", "")
    s = Replace(s, "（医財", "")
    s = Replace(s, "（医社", "")
    s = Replace(s, "（社）", "")
    s = Replace(s, "社福）", "")
    s = Replace(s, "社団）", "")
    s = Replace(s, "（社福", "")
    s = Replace(s, "（社団", "")
    s = Replace(s, "（農）", "")
    s = Replace(s, "（宗）", "")
    s = Replace(s, "（学）", "")
    s = Replace(s, "（財）", "")
    s = Replace(s, "（医）", "")
    s = Replace(s, "（相）", "")
    s = Replace(s, "（名）", "")
    s = Replace(s, "（資）", "")
    s = Replace(s, "（有）", "")
    s = Replace(s, "（株）", "")
    s = Replace(s, "ＮＰＯ", "")
    s = Replace(s, "事業団", "")
    s = Replace(s, "社）", "")
    s = Replace(s, "（社", "")
    s = Replace(s, "農）", "")
    s = Replace(s, "宗）", "")
    s = Replace(s, "学）", "")
    s = Replace(s, "財）", "")
    s = Replace(s, "医）", "")
    s = Replace(s, "相）", "")
    s = Replace(s, "名）", "")
    s = Replace(s, "資）", "")
    s = Replace(s, "有）", "")
    s = Replace(s, "株）", "")
    s = Replace(s, "（農", "")
    s = Replace(s, "（宗", "")
    s = Replace(s, "（学", "")
    s = Replace(s, "（財", "")
    s = Replace(s, "（医", "")
    s = Replace(s, "（相", "")
    s = Replace(s, "（名", "")
    s = Replace(s, "（資", "")
    s = Replace(s, "（有", "")
    s = Replace(s, "（株", "")
    s = Replace(s, "??", "")
    s = Replace(s, "??", "")
    法人格抜き = LTrim(RTrim(s))
End Function

として、並べ変えは「かな名」という列名の部分をクリックしてみて下さい。

（ウッシ） 2016/12/26(月) 14:44

（ウッシ）さん
ありがとうございます。
（株）関係の名称凄いことになるのですね(*^_^*)
起動させてみました。が
並べ替えは出来たのですが、重複も全て表示されるので
凄い行数となってます。重複はカットできますか？

よろしくお願いします。

（take） 2016/12/26(月) 14:59

済みません。

UserForm_Initialize、差し替えて下さい。

Private Sub UserForm_Initialize()

    Dim r As Range
    Dim t As Range
    Dim k As Variant
    With ListView1
        'プロパティ
        .View = lvwReport
        .LabelEdit = lvwManual
        .HideSelection = False
        .AllowColumnReorder = True
        .FullRowSelect = True
        .Gridlines = True
        ''列見出し
        .ColumnHeaders.Add , "_List", "社名", 150 '1列
        .ColumnHeaders.Add , "_Kana", " かな名", 150 '1列
    End With
    If Cells(5, 24).Value <> "" Then
        Set t = Range("X5", Cells(Rows.Count, "X").End(xlUp))

        With Me.ListView1
            .ListItems.Clear
            On Error Resume Next
            For Each r In t
                If r.Value <> "" Then
                    .ListItems.Add Key:=r.Value
                    If Err.Number = 0 Then
                        With .ListItems(.ListItems.Count)
                            .Text = r.Value
                            .SubItems(1) = Application.GetPhonetic(法人格抜き(r.Value))
                        End With
                    Else
                        Err.Clear
                    End If
                End If
            Next
            On Error GoTo 0
            If .ListItems.Count > 0 Then .ListItems(1).Selected = True
        End With
    Else
        MsgBox "データがありません", vbExclamation
    End If
End Sub

（ウッシ） 2016/12/26(月) 15:11

＞＞最初に昇順1回なら、
＞　↑これの意味はどういうことでしょうか

サンプル作ってみました。

ウッシさんの「法人格抜き」関数を利用させてもらってます。

Sub Reset_ListView()

    Dim rngT As Range
    Dim rngB As Range
    Dim c As Range
    Dim i As Long
    Dim s As String

    With Sheets(1)
        Set rngT = .Cells(5, "X")
        Set rngB = .Cells(.Rows.Count, "X").End(xlUp)
    End With

    With Me.ListView1.ListItems
        If rngT.Row <= rngB.Row Then
            For Each c In Range(rngT, rngB)
                If c.Value <> Empty Then
                    s = Application.GetPhonetic(法人格抜き(c.Value))
                    '=========挿入する位置の検索======
                    For i = 1 To .Count
                        If .Item(i).Key > s Then Exit For
                    Next
                    '=================================
                    On Error Resume Next
                    .Add Index:=i, Key:=s, Text:=c.Value '←挿入する位置を追加
                    On Error GoTo 0
                End If
            Next
        End If
        If .Count = 0 Then .Add Text:="デフォルト値"
        For i = 1 To .Count
            If .Item(i).Key = Sheets(1).Range("AC1").Value Then
                .Item(i).Selected = True
                Exit For
            End If
        Next
    End With
End Sub

2万件くらいで試したら、
応答なしでユーザーフォームが開くまで、
20～30分くらいかかってしまいました＞＜
250件くらいで2～3秒掛かりますかねぇ。。。
最初に使われている"Scripting.Dictionary"
を使えば、もう少し高速化出来るかも知れませんが、、、、
100件以上のリストから選択させるのは、
使う人にやさしくないですよねー

何文字か頭の文字を入力（または選択）して20件以内くらいにまずはリストを
絞り込む仕掛けが必要に思います。
（まっつわん） 2016/12/26(月) 16:47

こんにちは

あんまりデータ数が多かったら最初からシート上で重複削除して法人格抜きのデータとカナのデータを

セットしておくようにして、50音順にソートしておいた方が現実的ですよね。

「法人格抜き」もアドインにして数十件のリストで使っている感じですし。

（ウッシ） 2016/12/26(月) 16:53

（ウッシ）さん
（まっつわん）さん
ありがとうございます。
どちらもうまくできました。
やはり先頭(株)は同じようにカブ○○のようにソートする((株)千頭のグループになる)
方法でしか、並べ替え難しいみたいですね。
最初に入力するときに(株)無しにするしかないのでしょうか？
＞セットしておくようにして、50音順にソートしておいた方が現実的ですよね。
ありがとうございました。
（take） 2016/12/26(月) 17:03

（ウッシ）さん
以下の件ですが、教授お願いします。
＞あんまりデータ数が多かったら最初からシート上で重複削除して法人格抜きのデータとカナのデータを
＞セットしておくようにして、50音順にソートしておいた方が現実的ですよね。
確かにその通りと思います。よって
重複無しリストを"BE5"以下　"BF5"以下によみとして作成しました。よみ現在はランダム
(表示順です)
繰り返し変更ですみません。が
こちらをリストボックスにセットしたいのですが　"BF5"以下の読み順に(あいうえお順)
これをListView1に表示させる方法、ご教授お願いします。

（take） 2016/12/26(月) 17:53

コメント返信：

[ 一覧(最新更新順) ]

[[20161226014041]] 『ListBoxの代わりにListViewに表示させるには』（take） ページの最後に飛ぶ

[[20161226014041]]　『ListBoxの代わりにListViewに表示させるには』（take）　ページの最後に飛ぶ