VBA-自定义面板，使用SQL查询Excel数据

需求

定制插件，实现用户打开任意一个工作簿，写sql对Excel中的数据进行查询

---

案例sql需求场景：

需求

筛选日期小于’2023-4-24’，按group字段分组，求和各分组下的销售额，返回结果集新建工作表写入

数据源

现在有两个表，

一个用户的销售金额表，记录用户不同日期的销售金额，其中date字段是日期字段，数据在表格名为“Sheet1”的sheet页里

一个是用户分组表，表的数据第一个格子不在a1单元格

SQL语句

select t2.group,sum(t1.销售额) as sales from [Sheet1$] as t1 inner join [分组$c4:d7] as t2 on t1.姓名=t2.姓名 where format(date,'yyyy/m/dd')<'2023/4/24' group by t2.group

日期筛选，如果单元格的格式是日期，可在判断时先format格式成字符串再与字符串样式的日期做比较

sql中，或者在vba代码里，日期可以用两个#包围起来表示，筛选日期也可以这样：

select * from [Sheet1$] where date < #2023-4-23#（无需用单引号括起来）

sql中的数据表表示，如果数据左上角第一个格子是a1单元格，可以直接指定sheet名，比如：[Sheet1$]

如果不是，可以指定具体的数据范围，比如：[分组$c4:d7] 表格名后面跟一个$符号，后面紧跟单元格范围；

VBA代码

Sub sql_query()
' 使用sql对excel进行查询
Dim con, rs As Object
Dim query_sql, str As String
Dim i, cols As Long

Application.ScreenUpdating = True

' 创建对象
Set con = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

' 数据连接
con.Open "Provider=Microsoft.ace.Oledb.12.0;" _
    & "Extended Properties=Excel 12.0;" _
    & "Data Source=" & ActiveWorkbook.FullName
    
' sql 查询语句，如果单元格是日期，再判断时先format格式成字符串传入判断
query_sql = "select t2.group,sum(t1.销售额) as sales from [Sheet1$] as t1 inner join [分组$c4:d7] as t2 on t1.姓名=t2.姓名 where format(date,'yyyy/m/dd')<'2023/4/24' group by t2.group "
' query_sql = "select 姓名,date,销售额 from [Sheet1$] where format(date,'yyyy/m/dd')<'2023/4/24' "
' 执行sql语句
rs.Open query_sql, con, 1, 1


' 数据写入
Worksheets.Add    ' 新建工作表
With ActiveSheet
    cols = rs.Fields.Count
    For i = 0 To cols - 1
        .Cells(1, i + 1).Value = rs.Fields(i).Name  ' 写入表头
    Next
    .Cells(2, 1).CopyFromRecordset rs    ' 数据写入
End With

rs.Close
con.Close
Set con = Nothing

' 恢复屏幕刷新|工作表自动计算
Application.ScreenUpdating = True

End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

返回结果

一共两个组，筛选日期后，组1销售加总40，组2销售加总30

使用案例代码，只针对当前工作簿生效，如果打开其他工作簿，代码要一行一行重写

下面制作简易插件，先把基本功能搭起来，造个mvp产品

---

插件制作

1. 新建xlam插件文件

新建工作簿，另存为xlam插件格式的文件，这里命名为UDL.xlam

2. 编辑xml文件

编辑xml文件，具体请参考EXCEL自定义功能区制作:https://blog.csdn.net/me_to_007/article/details/118260245
如下，新增了功能组"SQL"，功能组里边有一个命名为SQL_QUERY的按钮，按钮回调了函数query

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon>
    <tabs>
        <tab id="myTab" label="my tab">
            <group id="group1" label="worksheet">
                <button id="button1" label="show name" size="large" onAction="show_activesheet_name" />
            group>
            <group id="group2" label="SQL">
                <button id="button2" label="SQL_Query" size="large" onAction="query" />
            group>
        tab>
    tabs>
ribbon>
customUI>
1
2
3
4
5
6
7
8
9
10
11
12
13
14

定义了回调函数：按钮点击会执行该函数

'Callback for button2 onAction
Sub query(control As IRibbonControl)
End Sub
1
2
3

这样就把功能面板做上去了，设置加载插件后，打开任意一个工作簿，我们可以看到功能该自定义按钮：

3. 制作窗体，定义窗体控件函数

弹出文本框，让用户输入sql查询，这里制作了一个简易的样例：两个文本标签+一个文本框+3个按钮

三按钮的default属性都设置为false，不然回车会触发按钮执行；
文本控件的ScrollBars属性设置为2：文本框内容过长，会有垂直滚条可以拉动

定义按钮函数-清空输入sql

Private Sub CommandButton2_Click()
UserForm1.TextBox1.Value = ""     ' 把文本框内容设置为空字符串即可
End Sub
1
2
3

定义按钮函数-生成样例sql

Private Sub CommandButton3_Click()
' 生成一个sql样例，供用户参考
UserForm1.TextBox1.Value = "select t2.group,sum(t1.销售额) as sales from [Sheet1$] as t1 inner join [分组$c4:d7] as t2 on t1.姓名=t2.姓名 where format(date,'yyyy/m/dd')<'2023/4/24' group by t2.group"
End Sub
1
2
3
4

定义按钮函数-执行sql
用户输入sql后，提交运行，这里我们只需要将上面的案例sql改下就好了，sql串使用用户文本框输入的内容，代码如下：

Private Sub CommandButton1_Click()
' 使用sql对excel进行查询
Dim con, rs As Object
Dim query_sql, str As String
Dim i, cols As Long

On Error GoTo line1

Application.ScreenUpdating = True   ' 关闭屏幕刷新

' 创建对象
Set con = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

' 数据连接
con.Open "Provider=Microsoft.ace.Oledb.12.0;" _
    & "Extended Properties=Excel 12.0;" _
    & "Data Source=" & ActiveWorkbook.FullName
    
' 传入用户输入的sql
query_sql = UserForm1.TextBox1.Value
rs.Open query_sql, con, 1, 1


' 数据写入
Worksheets.Add    ' 新建工作表
With ActiveSheet
    cols = rs.Fields.Count
    For i = 0 To cols - 1
        .Cells(1, i + 1).Value = rs.Fields(i).Name  ' 写入表头
    Next
    .Cells(2, 1).CopyFromRecordset rs    ' 数据写入
End With

rs.Close
con.Close

Set con = Nothing
Set rs = Nothing



' 恢复屏幕刷新|工作表自动计算
Application.ScreenUpdating = True

MsgBox "query done", vbInformation, "温馨提示"

line1:
If Err <> 0 Then
    UserForm1.TextBox1.Value = Err.Description
    MsgBox "请检查异常", vbQuestion, "Error"
End If

End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

4. 编辑回调函数

展示窗体即可，插入模块，在模块里编辑该函数

Sub query(control As IRibbonControl)
UserForm1.Show
UserForm1.TextBox1.MultiLine = True    ' 文本框多行显示
UserForm1.TextBox1.EnterKeyBehavior = False ' 文本框允许回车换行
End Sub
1
2
3
4
5

5. 效果展示

点击"SQL_Query"按钮弹出窗体，再点击"生成样例sql"按钮，生成了样例sql

点击"执行sql"按钮，弹出了异常提示，这里我只打开了插件，没找到相关工作簿数据；

sql语句正常执行，则会新建工作表，将查询结果写入进去。

---

插件下载及加载

下载插件：

微云链接：https://share.weiyun.com/eVg9FeWV 密码：fn8k43
1

加载插件

打开任意一个工作簿，加载路径如截图：

在加载项里浏览找到插件加载确定即可