こんにちは、Ryoです。
今回は以前のテーブル関連記事の延長線上になりますが、テーブル上のデータメンテナンスを目的としてユーザーフォームのリストボックスにデータを取込み、その中でデータ入れ替えをテーブルと連動させて実行したり、番号の振り直しや、セルへの書込みなどを活用例の1つとして書いてみましたので、内容を紹介したいと思います。
1.サンプル概要
先ず、以前作成したテーブル関連記事は以下になりますので、よろしければご参考までに。
今回は以下のテーブル（名前：テーブル１）をSheet名「Sample」に作成して準備していますので、これを用いて実行していきます。
次にユーザーフォームですが、構成は以下の通りです。
このUserForm1の起動時に初期設定として、テーブルを読み込んで2列表示設定にしていますので、表示させた時点でListBox1にはテーブル1のデータが2列（「No.」と「Code」）表示されます。
ListBox1には複数項目選択を可能にするMultiSelectを設定してあるので、入れ替えを行いたいデータを2つ選択して「Data入れ替え」ボタンを押します。
「1000」と「1005」を選択して「Data入れ替え」ボタンを押すとこの通りListBox1とテーブル1のデータが入れ替わります。
次に入れ替えたデータに対し、No.の振り直しを行うので「再No.割振り」ボタンを押すと「No.」部分のみソートされてListBox2に表示されます。
番号の振り直し後、テーブル1へ反映させるので「テーブル書込み」ボタンをクリックすると、テーブル1のデータが書き換わります。
以上がサンプル概要になります。
2.サンプルコード
◆UserForm初期設定
この設定はユーザーフォームが表示された時点で実行される初期化処理になります。ここで行うのはListBox1へのデータ追加とListBox2の表示設定です。
Private Sub UserForm_Initialize()
'＊＊ユーザーフォーム初期設定(初期化処理）＊＊
'リストボックス1に対する処理
With ListBox1
'複数項目を選択を可能にする
.MultiSelect = fmMultiSelectMulti
'.ListStyle = fmListStyleOption '参考：チェックボックス表示
'リストボックス1の列を2列に指定
.ColumnCount = 2
'リストボックス1の列幅をそれぞれ指定する
.ColumnWidths = "50;50"
'AddItemメソッドでデータ登録準備
.AddItem ""
'「テーブル1」のデータ範囲を指定し、
'リストボックス1へデータ登録
.List = Range(Range("A5"), _
Cells(Rows.Count, 5).End(xlUp)).Value
End With
'リストボックス2に対する処理
With ListBox2
'リストボックス2も1同様に2列指定
.ColumnCount = 2
'列幅も1と同内容にて指定
.ColumnWidths = "50;50"
End With
End Sub
内容はサンプルコード内に記述しているコメントの通りですが、ListBox1については.MultiSelectを使用することで複数選択を可能としていますが、コメント文で書いてある.ListStyle = fmListStyleOptionを使用するとチェックボックス表示にも変えられます。
次に可視性を良くするために「No.」と「Code」を表示したいので、 .ColumnCount = 2で2列表示とし列幅を.ColumnWidths = “50;50″で指定しています。
後はListBox1にテーブル1のデータを追加するので、AddItemメソッドでデータ登録準備（空データ.AddItem “”)を行い、テーブル1のデータ範囲を指定してListBox1にデータ登録しています。
.List = Range(Range(“A5”), Cells(Rows.Count, 5).End(xlUp)).Valueは始点A5から5列目（E列）の最終入力行を検索させて範囲を指定し、その範囲をデータとして取り込みますので、このような配列データになります。
ListBox2については、2列表示指定と列幅指定をListBox1同様に実行しています。
◆CommandButton1「Data入れ替え」
ここではリスト上の選択データ入れ替え処理を行います。
Private Sub CommandButton1_Click()
'＊＊リスト上選択データの入れ替え処理を行う＊＊
Dim i, nmA, nmB, cnt As Long
Dim DtA, DtB As Variant
With Worksheets("Sample").ListObjects("テーブル1")
'リストボックス1全データに対する処理
For i = 0 To ListBox1.ListCount - 1
'データが選択されている場合の分岐処理
If ListBox1.Selected(i) Then
'選択されたデータ数をカウント
cnt = cnt + 1
Select Case cnt
'1データ目の処理
Case 1
'nmA=テーブルの行番号
nmA = i + 1
'テーブル上の該当データ行を変数DtAに格納
DtA = .ListRows(nmA).Range
'2データ目の処理
Case 2
'nmB=テーブルの行番号
nmB = i + 1
'テーブル上の該当データ行を変数DtBに格納
DtB = .ListRows(nmB).Range
'リストボックス上のデータ選択が2を超えている場合は
'アラート表示⇒終了
Case Is > 2
MsgBox "データ数が多すぎます", vbCritical
End
End Select
End If
Next i
If cnt = 2 Then
'各選択データの入れ替え処理を行い、テーブルへ書き込む
.ListRows(nmA).Range = DtB
.ListRows(nmB).Range = DtA
Else
MsgBox "データ数が不足しています", vbCritical
End
End If
End With
'処理実行後にユーザーフォーム初期処理を実行することで
'テーブルの入れ替え後データをリストボックス1へ反映する
Call UserForm_Initialize
End Sub
リスト上のデータ入れ替えに併せてシート上のテーブル1のデータも入れ替えますので、With Worksheets(“Sample”).ListObjects(“テーブル1”)と指定しておきます。
次にListBox1全体に対する繰り返し処理を行いますが、このような流動的なデータを扱う際はTo ListBox1.ListCountと指定すれば自動的に登録データMax数となるので便利です。
ListBoxのデータは先頭から1で始まるのではなく「０」から始まるので、i=0とする関係上ListBoX1.ListCount-1としています。
リストボックス上のデータが選択されているかどうかは、 If ListBox1.Selected(i) Thenで判定しています。このサンプルでは2つのデータ入れ替えを目論んでいるので、Select Caseを用いて1データ目と2データ目のデータをそれぞれ取込み、データ不足や過多の場合は異常終了という流れにしています。
後は取り込んだデータを用いてテーブル1のデータを書き換え（入れ替え）を.ListRows(nmA).Range = DtB／.ListRows(nmB).Range = DtAで行い、最後に改めてUserForm1の初期処理Call UserForm_Initializeを実行することでListBox1へ書換データを反映させています。
◆CommandButton2「番号振り直し」
入れ替えたデータに対し、番号のみをソートして書き換える処理を行います。
Private Sub CommandButton2_Click()
'＊＊入れ替えデータに対し、番号を振り直す＊＊
Dim i, j, n As Long
Dim rep, Num(100) As Long
'リストボックス2のクリア
ListBox2.Clear
'リストボックス1の全データに対する処理
For i = 0 To ListBox1.ListCount - 1
'リストボックス1の「No.」データを読み込む
Num(i) = ListBox1.List(i, 0)
Next i
'読み込んだ「No.」データに対し並べ替え（ソート）を行う
'先頭行に対し、末尾データから降順で参照しながら
'データの入れ替えを行うことでソートする
For i = 0 To ListBox1.ListCount - 1
For j = ListBox1.ListCount - 1 To i Step -1
If Num(i) > Num(j) Then
rep = Num(i)
Num(i) = Num(j)
Num(j) = rep
End If
Next j
'リストボックス2に対する処理
With ListBox2
'リストボックス1の「No.」データを追加
.AddItem ListBox1.List(i, 0)
'追加した「No.」データをNum(i)に置換
.List(i, 0) = Num(i)
For n = 1 To 4
'リストボックス1の「No.以外」全データを
'リストボックス2に追加
.List(i, n) = ListBox1.List(i, n)
Next n
End With
Next i
Erase Num
End Sub
先ず最初にListBox2.Clearを実行し、データをクリアします。次にListBox1の「No.」データを全てNum(n)配列に読み込みます。
読み込んだ「No.」データに対し、For～Next文を用いてソート処理を行い、ListBox2へ順次書き込んでいきます。本サンプルではListBox1の全データをListBox2に移すので、For n=1 To 4～でListBox2へ追加する処理を行っていますが、ここは必要に応じて適宜変更しても良いと思います。
この処理を実行することで、ListBox2の「No.」が振り直されます。
◆CommandButton3「テーブルへ書込み」
ここではListBox2のデータをシート上のテーブル1に書込みを行います。
Private Sub CommandButton3_Click()
'＊＊リストボックス2のデータをテーブル1へ書き込む＊＊
Dim rng As Range
Dim i As Long
Dim hr As Variant
'テーブル1の見出し位置（セルアドレス）を取得
For Each rng In Worksheets("Sample"). _
ListObjects("テーブル1").HeaderRowRange
If rng.Value = "No." Then
hr = rng.Address(False, False)
Exit For
End If
Next
'セルを選択（見出し位置）
Range(hr).Select
For i = 0 To ListBox1.ListCount - 1
'リストボックス2の「No.」データを順にテーブル1に
'書込み処理を行う
ActiveCell.Offset(i + 1, 0) = ListBox2.List(i, 0)
Next i
'書込み後にユーザーフォーム初期設定を実行して
'リストボックス1に反映させる
Call UserForm_Initialize
End Sub
書込みを行う上でテーブル1の見出し位置をFor～Eachを使って検索しセルアドレスを取得していますが、見出し位置が固定であればRange(＊＊）.Selectから始めても良いと思います。
処理としては選択した見出し位置を基点としてOffsetで順に「No.」データをテーブルに書込んでいくものです。その後UserForm1の初期処理を再実行することで、ListBox1にデータを反映させています。
【参考】ListBoxでのマウススクロール有効化について
普通にListBoxを設置した場合はマウススクロールが使えませんので、データ量が多い場合などに不便を感じるものです。使用したい場合は以下のコードをそれぞれUserFormと標準モジュールに追加すれば使用できるようになりますので、ご参考までに。
参考元サイトはこちらです。
≪UserFormへ追加≫
Private Sub ListBox1_MouseMove( _
ByVal Button As Integer, ByVal Shift As Integer, _
ByVal x As Single, ByVal y As Single)
HookListBoxScroll
End Sub
Private Sub ListBox2_MouseMove( _
ByVal Button As Integer, ByVal Shift As Integer, _
ByVal x As Single, ByVal y As Single)
HookListBoxScroll
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
UnhookListBoxScroll
End Sub
≪標準モジュールへ追加≫
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MOUSEHOOKSTRUCT
pt As POINTAPI
hwnd As Long
wHitTestCode As Long
dwExtraInfo As Long
End Type
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" _
Alias "PostMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As POINTAPI) As Long
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201
Private mLngMouseHook As Long
Private mListBoxHwnd As Long
Private mbHook As Boolean
Sub HookListBoxScroll()
Dim lngAppInst As Long
Dim hwndUnderCursor As Long
Dim tPT As POINTAPI
GetCursorPos tPT
hwndUnderCursor = WindowFromPoint(tPT.x, tPT.y)
If mListBoxHwnd <> hwndUnderCursor Then
UnhookListBoxScroll
mListBoxHwnd = hwndUnderCursor
lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
If Not mbHook Then
mLngMouseHook = SetWindowsHookEx( _
WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
mbHook = mLngMouseHook <> 0
End If
End If
End Sub
Sub UnhookListBoxScroll()
If mbHook Then
UnhookWindowsHookEx mLngMouseHook
mLngMouseHook = 0
mListBoxHwnd = 0
mbHook = False
End If
End Sub
Private Function MouseProc( _
ByVal nCode As Long, ByVal wParam As Long, _
ByRef lParam As MOUSEHOOKSTRUCT) As Long
On Error GoTo errH 'Resume Next
If (nCode = HC_ACTION) Then
If WindowFromPoint(lParam.pt.x, lParam.pt.y) = mListBoxHwnd Then
If wParam = WM_MOUSEWHEEL Then
MouseProc = True
If lParam.hwnd > 0 Then
PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
Else
PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
End If
PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
Exit Function
End If
Else
UnhookListBoxScroll
End If
End If
MouseProc = CallNextHookEx( _
mLngMouseHook, nCode, wParam, ByVal lParam)
Exit Function
errH:
UnhookListBoxScroll
End Function
これらを追加することでListBoxでマウスホイールを使ってスクロールできて便利なので、私も今後使って行こうと思います。
3.まとめ
今回はお問い合わせいただいた内容を基に、テーブル上のデータをユーザーフォーム上で扱い、編集することを主としてサンプルを書いています。
各記述の構文などまで書いていくと内容が煩雑で冗長になるので割愛していますから判り難い部分もあるかもしれませんが、何となくTableとListBoxデータの扱い方がサンプルを通じて伝わってくれると嬉しいなと思います。
以上、テーブルのデータをリストボックスで編集する方法についてでした！今回の記事が何かの参考になれば幸いです。
Ryo
