Excelが大好きだ!

Excel大好き経理マンがExcelの事を書き綴っていきます。


スポンサードリンク

「思い立ったら即SQL」ユーザーフォームからSQL実行

例えば、 「血液型って何種類あるんだよ~」

となった時にピボットテーブルや重複の削除機能を利用するのが普通かと思います。
f:id:ExcelLover:20220326231841p:plain



しかしそんなあなたにSQLでの集計をお勧めしたい!


しかも一々コードを書く必要はありません!
ショートカットキーでフォームを呼び出しSQL文を記入して、
ポチッとボタン一発で思い通りの集計が出来ます!


完成品動作

このように選択範囲に対してSQLを実行することが出来ます。
テーブル範囲は上部のテキストボックスで変更することも可能です。 f:id:ExcelLover:20220326232020g:plain

選択範囲の最上部をヘッダーと見做して一覧表示しています。
一覧をダブルクリックすることでSQL文に差し込むことが出来ます。
f:id:ExcelLover:20220326231917g:plain

コード

ユーザーフォーム

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) の値を使用します。

TextBox.SelStart プロパティ)


SelStartはカーソル位置の取得・指定を行うことが出来ます。

Me.TextBox2.SelStart = 7

f:id:ExcelLover:20220326232105p:plain

上記のコードはユーザーフォーム起動時に実行しています。
SelStartに「7」を指定していますので、通常は文末に設定されるカーソル位置が文章の前から7文字目の位置に設定されています。

この位置にカーソルを移動させているのはSelect文の列設定をこの位置から書き始めるからです。


SelText

もう1つの発見がSelTextです。

選択されたコントロールのテキストを取得または設定します。

SelText プロパティ)

今回のアドインでは使用していませんが、TextBox内の選択しているテキストを取得することが出来ます。
f:id:ExcelLover:20220326232130g:plain


アドインで使用している設定側はTextBox内のカーソル位置にテキストを設定することが出来ます。
f:id:ExcelLover:20220326232216g:plain

モジュール

モジュール側は当blogにおいては目新しい内容が無いので詳細は割愛。


まとめ

こういうのをふと思いついて勢いで作るのは楽しいですね。
自分のアイデアをすぐ形にできるのはVBAを勉強していて良かったと思います。

このアドオンを使い倒すことになるかどうかわかりませんが、ふとした時に使える道具があるってのが良いんです。