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
相关推荐
我材不敲代码3 小时前
Python实现打包贪吃蛇游戏
开发语言·python·游戏
身如柳絮随风扬4 小时前
Java中的CAS机制详解
java·开发语言
韩立学长5 小时前
【开题答辩实录分享】以《基于Python的大学超市仓储信息管理系统的设计与实现》为例进行选题答辩实录分享
开发语言·python
超级大只老咪5 小时前
快速进制转换
笔记·算法
froginwe115 小时前
Scala 循环
开发语言
m0_706653236 小时前
C++编译期数组操作
开发语言·c++·算法
故事和你916 小时前
sdut-Java面向对象-06 继承和多态、抽象类和接口(函数题:10-18题)
java·开发语言·算法·面向对象·基础语法·继承和多态·抽象类和接口
Bruk.Liu6 小时前
(LangChain实战2):LangChain消息(message)的使用
开发语言·langchain
qq_423233906 小时前
C++与Python混合编程实战
开发语言·c++·算法
m0_715575346 小时前
分布式任务调度系统
开发语言·c++·算法