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
相关推荐
世转神风-2 小时前
qt-初步编译运行报错-When executing step “Make“-无法启动进程“make“
开发语言·qt
..空空的人2 小时前
C++基于protobuf实现仿RabbitMQ消息队列---服务器模块认识1
服务器·开发语言·c++·分布式·rabbitmq·protobuf
码界奇点2 小时前
基于Golang的微服务API网关系统设计与实现
开发语言·微服务·golang·毕业设计·yapi·源代码管理
sg_knight2 小时前
Python 中的常用设计模式工具与库
开发语言·python·设计模式
张人玉2 小时前
C# WPF 折线图制作笔记(LiveCharts 库)
笔记·c#·wpf·折线图·linechart
cike_y2 小时前
Mybatis增删改查&CURD
java·开发语言·tomcat·mybatis·安全开发
froginwe112 小时前
PHP MySQL 插入数据
开发语言
码界奇点2 小时前
基于Go语言的Web管理面板系统设计与实现
开发语言·后端·golang·毕业设计·web·go语言·源代码管理
小此方2 小时前
Re: ゼロから学ぶ C++ 入門(六)类和对象·第三篇:运算符重载
开发语言·c++·后端