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