Windows 10 Pro_x64 + Excel2013_x86 VBA で ListBox 間でデータを移動する

Windows 10 Pro_x64 + Excel2013_x86 VBA で ListBox 間でデータを移動する

 

Excel VBA のUserForm上の2個のListBox間でデータを移動する時のメモ

普段はデータベースからひらってきたデータを表示することが多いんだけど

最小限必要なコードを張りつけてみる

 

・UserFormを1個追加する

・UserFormの上にListBoxを2個追加する

・CommandButtonの上にCommandButtonを2個追加する

・UserForm_Initialize で ListBox1 に初期データを追加する

・CommandButton1のクリックで ListBox1の選択データ->ListBox2

 へ移動しソート後表示する

・CommandButton2のクリックで ListBox2の選択データ->ListBox1

 へ移動しソート後表示する

・ソートは2次元配列で行っているが、これは単なる手抜き

・ListBoxの複数行選択には、対応していない(いずれ実装してみたい

対象データは以下の全国一括(KEN_ALL.CSV)より一部抜粋

郵便番号データダウンロード

項目の説明は以下より抜粋

郵便番号データの説明

Windows 10 Pro_x64 + Excel2013_x86 VBA で Dictionary を辞書順にソートする

サンプルコード

Option Explicit

Private Type typDemo
    DspSeq      As String   ' 表示順(キーにする)
    KbnCode     As String   ' 全国地方公共団体コード
    ZipCode     As String   ' 郵便番号(7桁)
    CityName    As String   ' 市区町村名
    TownName    As String   ' 町域名
End Type

Dim lstType()   As typDemo

Private Sub UserForm_Initialize()
'
    ListBox1.Clear
    ListBox2.Clear
'
    ListBox1.ColumnWidths = "0 pt; 30 pt;40 pt;70 pt;70 pt"
    ListBox1.ColumnCount = 5
    ListBox2.ColumnWidths = "0 pt; 30 pt;40 pt;70 pt;70 pt"
    ListBox2.ColumnCount = 5
    '
    '   リストの初期化
    '
    ListBox1.AddItem ""
    ListBox1.List(0, 0) = "000000"
    ListBox1.List(0, 1) = "01101"
    ListBox1.List(0, 2) = "0640954"
    ListBox1.List(0, 3) = "札幌市中央区"
    ListBox1.List(0, 4) = "宮の森四条"
    ListBox1.AddItem ""
    ListBox1.List(1, 0) = "000001"
    ListBox1.List(1, 1) = "01102"
    ListBox1.List(1, 2) = "0028071"
    ListBox1.List(1, 3) = "札幌市北区"
    ListBox1.List(1, 4) = "あいの里一条"
    ListBox1.AddItem ""
    ListBox1.List(2, 0) = "000002"
    ListBox1.List(2, 1) = "01103"
    ListBox1.List(2, 2) = "0070880"
    ListBox1.List(2, 3) = "札幌市東区"
    ListBox1.List(2, 4) = "丘珠町"
    ListBox1.AddItem ""
    ListBox1.List(3, 0) = "000003"
    ListBox1.List(3, 1) = "02201"
    ListBox1.List(3, 2) = "0301271"
    ListBox1.List(3, 3) = "青森市"
    ListBox1.List(3, 4) = "六枚橋"
    ListBox1.AddItem ""
    ListBox1.List(4, 0) = "000004"
    ListBox1.List(4, 1) = "02202"
    ListBox1.List(4, 2) = "0361516"
    ListBox1.List(4, 3) = "弘前市"
    ListBox1.List(4, 4) = "藍内"
    ListBox1.AddItem ""
    ListBox1.List(5, 0) = "000005"
    ListBox1.List(5, 1) = "03201"
    ListBox1.List(5, 2) = "0200886"
    ListBox1.List(5, 3) = "盛岡市"
    ListBox1.List(5, 4) = "若園町"
    ListBox1.AddItem ""
    ListBox1.List(6, 0) = "000006"
    ListBox1.List(6, 1) = "03202"
    ListBox1.List(6, 2) = "0270202"
    ListBox1.List(6, 3) = "宮古市"
    ListBox1.List(6, 4) = "赤前"
End Sub

'=================================================================
' 機 能 : ListBox1の選択データ -> ListBox2 へ移動しソート後表示する
'=================================================================
Private Sub CommandButton1_Click()
    '
    '   ListBox1の項目が選択されていない場合
    '
    If ListBox1.ListIndex < 0 Then Exit Sub
    '
    '   ListBox1で選択されている項目をコピーする
    '
    Call List2Data(ListBox1, lstType)
    '
    '   List2にデータをソート後追加する
    '
    Call Data2List(ListBox2, lstType)
End Sub

'=================================================================
' 機 能 : ListBox2の選択データ -> ListBox1 へ移動しソート後表示する
'=================================================================
Private Sub CommandButton2_Click()
    '
    '   ListBox2の項目が選択されていない場合
    '
    If ListBox2.ListIndex < 0 Then Exit Sub
    '
    '   ListBox1のデータを配列にバックアップ
    '
    Call List2Data(ListBox2, lstType)
    '
    '   List1にデータをソート後追加する
    '
    Call Data2List(ListBox1, lstType)
End Sub

'=================================================================
' 機 能 : ListBoxで選択されている項目を配列にコピー後削除する
'       : 複数行には未対応
'=================================================================
Private Sub List2Data(aList As Control, alstType() As typDemo)
'
    ReDim alstType(0)
'
    alstType(0).DspSeq = (aList.List(aList.ListIndex, 0))
    alstType(0).KbnCode = (aList.List(aList.ListIndex, 1))
    alstType(0).ZipCode = (aList.List(aList.ListIndex, 2))
    alstType(0).CityName = (aList.List(aList.ListIndex, 3))
    alstType(0).TownName = (aList.List(aList.ListIndex, 4))
'
    aList.RemoveItem (aList.ListIndex)
End Sub

'=================================================================
' 機 能 : 配列のデータをソート後リストにセットする
'=================================================================
Private Sub Data2List(aList As Control, alstType() As typDemo)
'
    Dim tmpType()   As typDemo
    Dim strArry()   As String
    Dim intCnt      As Integer
    Dim intNum      As Integer
'
    ReDim Preserve tmpType(aList.ListCount)
    '
    '   ListBoxのデータを配列にコピーする
    '
    For intCnt = 0 To aList.ListCount - 1
        tmpType(intCnt).DspSeq = (aList.List(intCnt, 0))
        tmpType(intCnt).KbnCode = (aList.List(intCnt, 1))
        tmpType(intCnt).ZipCode = (aList.List(intCnt, 2))
        tmpType(intCnt).CityName = (aList.List(intCnt, 3))
        tmpType(intCnt).TownName = (aList.List(intCnt, 4))
    Next
    '
    '   ListBoxに追加されるデータを配列にコピーする
    '
    tmpType(aList.ListCount).DspSeq = (alstType(0).DspSeq)
    tmpType(aList.ListCount).KbnCode = (alstType(0).KbnCode)
    tmpType(aList.ListCount).ZipCode = (alstType(0).ZipCode)
    tmpType(aList.ListCount).CityName = (alstType(0).CityName)
    tmpType(aList.ListCount).TownName = (alstType(0).TownName)
'
    ReDim strArry(UBound(tmpType) * 2, 1)
    '
    '   ソート用の配列にデータをセットする
    '
    For intCnt = 0 To UBound(tmpType)
        strArry(intCnt, 0) = (tmpType(intCnt).DspSeq)
        strArry(intCnt, 1) = (tmpType(intCnt).KbnCode)
    Next
'
    Call QuickSort(strArry, LBound(tmpType), UBound(tmpType))
'
    aList.Clear
    aList.ColumnWidths = "0 pt; 30 pt;40 pt;70 pt;70 pt"
    aList.ColumnCount = 5
    '
    '   ソートされた表示順に従い、ListBoxに追加する
    '
    For intCnt = 0 To UBound(tmpType)
        For intNum = 0 To UBound(tmpType)
            If strArry(intCnt, 0) = tmpType(intNum).DspSeq Then
                aList.AddItem ""
                aList.List(intCnt, 0) = (tmpType(intNum).DspSeq)
                aList.List(intCnt, 1) = (tmpType(intNum).KbnCode)
                aList.List(intCnt, 2) = (tmpType(intNum).ZipCode)
                aList.List(intCnt, 3) = (tmpType(intNum).CityName)
                aList.List(intCnt, 4) = (tmpType(intNum).TownName)
                Exit For
            End If
        Next
    Next
End Sub