EXCEL使用VBA代码实现按条件查询数据库--简单实用

工作中遇到很多场景需要从应用系统的数据库查询各种数据,方法有很多如:免费的POWER QUERY,收费的帆软等报表软件。

如果你没有报表平台也没有开发基础,可以使用EXCEL的VBA+ADO链接数据库,编写SQL就能实现动态的参数查询,简单实用。

目录

实现效果:

用户输入查询参数,点击查询按钮。即可从数据库获取数据并展示到excel中;

实现流程:

  1. 表单设计
  2. SQL编写
  3. VBA编程

实现步骤

设计一个按钮用于点击查询:

双击进入代码:

bash 复制代码
Private Sub CommandButton2_Click()

End Sub

基础代码:

获取用户在文本框中输入的内容

bash 复制代码
' 获取用户在文本框中输入的内容'
	inputValue = ThisWorkbook.Sheets("Sheet1").TextBox1.Value 
'假设文本框在Sheet1工作表,名称为TextBox1,需根据实际情况修改'

获取sheet中某个单元格的值

bash 复制代码
'获取单元格的值(F1)'
    pramrs = ThisWorkbook.Sheets("Sheet1").Range("F1").Value

获取工作表的最后一行和最后一列

bash 复制代码
' 获取工作表的最后一行和最后一列'
    Dim lastRow As Long
    Dim lastCol As Long
    lastRow = ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row    ' 获取工作表的最后一行'
    lastCol = ThisWorkbook.Sheets("Sheet1").Cells(2, ThisWorkbook.Sheets("Sheet1").Columns.Count).End(xlToLeft).Column ' 获取工作表的最后一列'

清除整个工作表中的现有数据

bash 复制代码
 ' 清除工作表中的现有数据'
 	ThisWorkbook.Sheets("Sheet1").Cells.ClearContents

清除工作表中指定区域的现有数据

bash 复制代码
 ' 清除工作表中指定区域的现有数据'
 	 ' 清除range() 区域cell(2,1)--最大行列 的内容'
    ThisWorkbook.Sheets("Sheet1").Range(
    	ThisWorkbook.Sheets("Sheet1").Cells(2, 1), 	
    	ThisWorkbook.Sheets("Sheet1").Cells(lastRow, lastCol)
    	).ClearContents

数据库连接

bash 复制代码
 	Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim serverName As String
    Dim databaseName As String
    Dim userName As String
    Dim password As String
    Dim connectionString As String
    Dim prarms As String
    

'设置数据库连接信息'
    serverName = "localhost:30015"
    databaseName = "MyDB"
    userName = "user"
    password = "password"
' ---------------------------------------------------'
' 构建连接字符串'
    'SqlServer'
    connectionString = "Provider=SQLOLEDB;Data Source=" & serverName & ";Initial Catalog=" & databaseName & ";User ID=" & userName & ";Password=" & password
    'Mysql'
    connectionString = "DRIVER={MySQL ODBC 9.2 ANSI Driver};SERVER=" & serverName & ";DATABASE=" & databaseName & ";UID=" & userName & ";PWD=" & password & ";OPTION=3;"
    'SAP hana'
     connectionString = "DRIVER={HDBODBC};ServerNode=" & serverName & ";DATABASE=" & databaseName & ";UID=" & userName & ";PWD=" & password
' ---------------------------------------------------'
   ' 创建并打开连接'
    Set conn = New ADODB.Connection
    conn.Open connectionString
' ---------------------------------------------------'
  ' 构建SQL查询语句,根据用户输入进行查询    '
	sql = "select * from vbak"
 ' 创建记录集 '
    Set rs = New ADODB.Recordset
    rs.Open sql, conn
 ' 单元格填充数据'
    ThisWorkbook.Sheets("Sheet1").Cells(3, 1).CopyFromRecordset rs
' ---------------------------------------------------'
 ' 关闭记录集和连接
    rs.Close
    conn.Close
    
    ' 释放对象
    Set rs = Nothing
    Set conn = Nothing

将查询结果填充到Excel工作表

bash 复制代码
' 将查询结果输出到Excel工作表'
    If Not rs.EOF Then
        ' 定义列名'
        ThisWorkbook.Sheets("Sheet1").Cells(2, 1).Value = "ID"
        ThisWorkbook.Sheets("Sheet1").Cells(2, 2).Value = "名称"
        ThisWorkbook.Sheets("Sheet1").Cells(2, 3).Value = "国家编码"
        ThisWorkbook.Sheets("Sheet1").Cells(2, 4).Value = "国家编码A"
        ' ...'

        ' 单元格填充数据'
        ThisWorkbook.Sheets("Sheet1").Cells(3, 1).CopyFromRecordset rs
    End If

VBA完整代码:

bash 复制代码
Private Sub CommandButton1_Click()
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim inputValue As String
    Dim serverName As String
    Dim databaseName As String
    Dim userName As String
    Dim password As String
    Dim connectionString As String
    Dim prarms As String
    
    
    
    
    
 

	'设置数据库连接信息'
    serverName = "localhost:30015"
    databaseName = "MyDB"
    userName = "user"
    password = "password"
    
    ' 构建连接字符串
    'SqlServer
    'connectionString = "Provider=SQLOLEDB;Data Source=" & serverName & ";Initial Catalog=" & databaseName & ";User ID=" & userName & ";Password=" & password
    'Mysql
    'connectionString = "DRIVER={MySQL ODBC 9.2 ANSI Driver};SERVER=" & serverName & ";DATABASE=" & databaseName & ";UID=" & userName & ";PWD=" & password & ";OPTION=3;"
    'SAP hana
     connectionString = "DRIVER={HDBODBC};ServerNode=" & serverName & ";DATABASE=" & databaseName & ";UID=" & userName & ";PWD=" & password
    
    
    ' 创建并打开连接
    Set conn = New ADODB.Connection
    conn.Open connectionString
    
    '---------------------------------------------------------------------------------------------------------------------------
    
    ' 构建SQL查询语句,根据用户输入进行查询
    
    'sql = "SELECT * FROM city WHERE countycode = '" & inputValue & "'"  '假设根据某一列进行模糊查询,需根据实际情况修改表名和列名
    'sql = "SELECT id as 'id' ,name as '名称' ,countrycode as '国家编码'  FROM city "
    'WHERE countycode = 'ARG'   '假设根据某一列进行模糊查询,需根据实际情况修改表名和列名"
    
    'sql = "select * from vbak"
    
      

    If Len(ThisWorkbook.Sheets("Sheet1").Range("F1").Value) = 0 Then
        prarms = ""
    Else
        prarms = " and VBELN like '%" & ThisWorkbook.Sheets("Sheet1").Range("F1").Value & "%'"
    End If
    
    'Debug.Print "prarms 的值是: " & prarms
    
    '获取单元格的值'
    pramrs = ThisWorkbook.Sheets("Sheet1").Range("F1").Value
    sql = "select * from vbak where 1=1 " & prarms
    
    
    '---------------------------------------------------------------------------------------------------------------------------
    
    ' 创建记录集
    Set rs = New ADODB.Recordset
    rs.Open sql, conn
    

    ' 清除工作表中的现有数据
    'ThisWorkbook.Sheets("Sheet1").Cells.ClearContents
    
    ' 获取工作表的最后一行和最后一列,并清除
    Dim lastRow As Long
    Dim lastCol As Long
    lastRow = ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").Rows.Count, 1).End(xlUp).Row
    lastCol = ThisWorkbook.Sheets("Sheet1").Cells(2, ThisWorkbook.Sheets("Sheet1").Columns.Count).End(xlToLeft).Column
    ' 清除range() 区域cell(2,1)--最大行列 的内容
    ThisWorkbook.Sheets("Sheet1").Range(ThisWorkbook.Sheets("Sheet1").Cells(2, 1), ThisWorkbook.Sheets("Sheet1").Cells(lastRow, lastCol)).ClearContents


    
    ' 将查询结果输出到Excel工作表
    If Not rs.EOF Then
        ' 定义列名
        ThisWorkbook.Sheets("Sheet1").Cells(2, 1).Value = "ID"
        ThisWorkbook.Sheets("Sheet1").Cells(2, 2).Value = "名称"
        ThisWorkbook.Sheets("Sheet1").Cells(2, 3).Value = "国家编码"
        ThisWorkbook.Sheets("Sheet1").Cells(2, 4).Value = "国家编码A"
        ' 单元格填充数据
        ThisWorkbook.Sheets("Sheet1").Cells(3, 1).CopyFromRecordset rs
    End If
    
    ' 关闭记录集和连接
    rs.Close
    conn.Close
    
    ' 释放对象
    Set rs = Nothing
    Set conn = Nothing

End Sub
相关推荐
青山是哪个青山4 小时前
LangChain 学习笔记(四):Message 与提示词模板
笔记·学习·langchain
WWJA王文举6 小时前
I²C通信完整流程详解:START、地址、ACK、数据、Repeated START和STOP一次讲透
c语言·开发语言
zhanghaha13146 小时前
Python进阶教程:6_JSON 数据解析 —— 新手完全指南
开发语言·python·json
Shell运维手记7 小时前
Linux 常用基础命令学习笔记
linux·运维·笔记·学习·算法·github
qq_448011168 小时前
C语言中的动态内存分配
c语言·开发语言·php
FakeOccupational8 小时前
【电路笔记 STM32】Cortex-M7 内核上的数据缓存(D-Cache)结构+MPU+DMA&Cache+STM32CubeMX配置
笔记·stm32·缓存
慧一居士8 小时前
Hologres 功能及使用场景介绍,实践详细步骤示例
数据仓库
动词ing8 小时前
【学习笔记】C语言(数组指针与指针数组+字符数组+函数+参数传递+字符串作为形参+递归函数+指针函数+回调函数+结构体嵌套+内存动态分配函数)
c语言·笔记·学习
汉字萌萌哒8 小时前
2024CSP-J入门级C++真题详解
开发语言·c++
arbboter9 小时前
【网络工具】NetProxy网络代理用户手册
开发语言·网络·c#·网络代理·网络异常·代理工具