例えば、 「血液型って何種類あるんだよ~」
となった時にピボットテーブルや重複の削除機能を利用するのが普通かと思います。
しかしそんなあなたにSQLでの集計をお勧めしたい!
しかも一々コードを書く必要はありません!
ショートカットキーでフォームを呼び出しSQL文を記入して、
ポチッとボタン一発で思い通りの集計が出来ます!
完成品動作
このように選択範囲に対してSQLを実行することが出来ます。
テーブル範囲は上部のテキストボックスで変更することも可能です。
選択範囲の最上部をヘッダーと見做して一覧表示しています。
一覧をダブルクリックすることでSQL文に差し込むことが出来ます。
コード
ユーザーフォーム
Option Explicit Private Sub UserForm_Initialize() Me.TextBox1.Value = ActiveSheet.Name & "$" & Selection.Address(False, False) Me.TextBox2.Value = "select * from [テーブル$]" Me.TextBox2.SelStart = 7 Dim myRng As Range For Each myRng In Intersect(Selection, Selection.Cells(1, 1).EntireRow) Me.ListBox1.AddItem myRng.Value Next End Sub Private Sub CommandButton1_Click() 選択範囲にSQL文を実行 Me.TextBox1.Value, Me.TextBox2.Value Unload Me End Sub Private Sub CommandButton2_Click() Unload Me End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.TextBox2.SelText = Me.ListBox1.Value & "," End Sub Private Sub UserForm_Activate() Me.TextBox2.SetFocus End Sub
モジュール
Sub 選択範囲にSQL文を実行(テーブル範囲 As String, SQL文 As String) Dim myCon As ADODB.Connection: Set myCon = New ADODB.Connection myCon.Provider = "Microsoft.ACE.OLEDB.12.0" myCon.Properties("Extended Properties") = "Excel 12.0;IMEX=1" myCon.Open ThisWorkbook.FullName Dim myRS As ADODB.Recordset: Set myRS = New ADODB.Recordset Dim mySQL As String: mySQL = SQL文 mySQL = Replace(mySQL, "[テーブル$]", "[" & テーブル範囲 & "]") myRS.Open mySQL, myCon, adOpenStatic Dim myVar As Variant Dim zレコード件数 As Long: zレコード件数 = CLng(myRS.RecordCount) Dim zフィールド列数 As Long: zフィールド列数 = CLng(myRS.Fields.Count) If zレコード件数 <= 0 Then myVar = Array() Else ReDim myVar(1 To zレコード件数 + 1, 1 To zフィールド列数) Dim i As Long Dim n As Long For n = 1 To CLng(zフィールド列数) myVar(1, n) = myRS.Fields(n - 1).Name Next For i = 2 To UBound(myVar, 1) For n = LBound(myVar, 2) To UBound(myVar, 2) myVar(i, n) = myRS.Fields(n - 1).Value Next myRS.MoveNext Next End If Dim myWB As Workbook: Set myWB = Workbooks.Add myWB.ActiveSheet.Range("A1").Resize(UBound(myVar, 1), UBound(myVar, 2)).Value = myVar myWB.Activate Set myWB = Nothing myRS.Close: Set myRS = Nothing myCon.Close: Set myCon = Nothing End Sub
SelStart
今回作った中での新しい発見の1つはこのSelStartでした。
SelStart プロパティ は、選択したテキストの開始位置、またはテキストが選択されている場合のカーソル位置を指定または決定します。 値の取得および設定が可能です。整数型 (Integer) の値を使用します。
SelStartはカーソル位置の取得・指定を行うことが出来ます。
Me.TextBox2.SelStart = 7
上記のコードはユーザーフォーム起動時に実行しています。
SelStartに「7」を指定していますので、通常は文末に設定されるカーソル位置が文章の前から7文字目の位置に設定されています。
この位置にカーソルを移動させているのはSelect文の列設定をこの位置から書き始めるからです。
SelText
もう1つの発見がSelTextです。
選択されたコントロールのテキストを取得または設定します。
今回のアドインでは使用していませんが、TextBox内の選択しているテキストを取得することが出来ます。
アドインで使用している設定側はTextBox内のカーソル位置にテキストを設定することが出来ます。
モジュール
モジュール側は当blogにおいては目新しい内容が無いので詳細は割愛。
まとめ
こういうのをふと思いついて勢いで作るのは楽しいですね。
自分のアイデアをすぐ形にできるのはVBAを勉強していて良かったと思います。
このアドオンを使い倒すことになるかどうかわかりませんが、ふとした時に使える道具があるってのが良いんです。