excel vba如何实现通过表一对表二的数据进行查询与修改，表一为查询表，表二为数据库表

i = 1

j = 1

Do While 表1Cells(i, 1) <> ""

Do While 表2Cells(j, 1) <> ""

k = InStr(表1Cells(i, 1), 表2Cells(j, 1))

If k Then 表1Cells(i, 1) = Left(表1Cells(i, 1), k - 1) + 表2Cells(i, 2) + Right(表1Cells(i, 1), Len(表1Cells(i, 1)) - k - 1)

Exit Do

Else

End If

j = j + 1

Loop

i = i + 1

Loop

这里的表1和表2用真实的表名和文件路径替换

1首先你没有关闭ExcelApplication，你只是xlApp = Nothing

，让对象失去引用。应该让xlAppquit并在执行这行代码前关闭xlApp打开的所有Excel文件。

2不建议你这样CreateObject("ExcelApplication") 。因为Excel进程不是那么容易关掉的，你可以直接用执行这段代码的Excel，就是直接用Application。

也就是Set xlBook = xlAppWorkbooksAdd

改成Set xlBook = ApplicationWorkbooksAdd

1、打开相应的access数据库。

2、在左边的对象栏里单击模块，观察右边的窗口，如果里面有模块，可以双击打开。如果没有新建一个模块，然后双击打开。

3、粘贴以下代码并运行、观察立即窗口。

Private Sub aaaa()

    Dim TableName As String, FieldName As String, i As Integer

    TableName = "tb1" '表名 tb1

    FieldName = "编号" '字段名 编号

    

        Select Case CurrentDbTableDefs(TableName)(FieldName)Type

        Case dbBoolean

            DebugPrint "是/否"

        Case dbByte

            DebugPrint "数字(字节)"

        Case dbInteger

            DebugPrint "数字(整型)"

        Case dbLong

            If (CurrentDbTableDefs(TableName)(FieldName)Attributes And dbAutoIncrField) = dbAutoIncrField Then

                DebugPrint "自动编号(长整型)"

            Else

                DebugPrint "数字(长整型)"

            End If

        Case dbSingle

            DebugPrint "数字(单精度)"

        Case dbDouble

            DebugPrint "数字(双精度)"

        Case dbDecimal

            DebugPrint "数字(小数)"

        Case dbCurrency

            DebugPrint "货币"

        Case dbDate

            DebugPrint "日期/时间"

        Case dbText

            DebugPrint "文本"

        Case dbMemo

            If (CurrentDbTableDefs(TableName)(FieldName)Attributes And dbHyperlinkField) = dbHyperlinkField Then

                DebugPrint "超链接"

            Else

                DebugPrint "备注"

            End If

        Case dbGUID

            DebugPrint "自动编号(自动复制ID)"

        End Select

    

End Sub

Microsoft Office Access是由微软发布的关系数据库管理系统。它结合了 MicrosoftJet Database Engine 和 图形用户界面两项特点，是 Microsoft Office 的系统程序之一。用vba代码将access数据库连接求代码，代码如下：

Sub FYMXDL()

Dim XQID As Integer

Dim JZID As Integer

Dim FYID As Integer

Dim FBXZ As String '分包性质

Dim DW As String

Dim SARR(1 To 31) As Double

Dim rst As New ADODBRecordset

mYpath = ThisWorkbookPath & "\jzfydataaccdb"

Set cONn = CreateObject("ADODBConnection")

cONnConnectionString = "Provider=MicrosoftAceOleDB120;Data Source=" & mYpath

cONnConnectionString = cONnConnectionString & ";Jet OLEDB:Database "

cONnOpen

XQID = Cells(3, 2)Value

JZID = Cells(3, 5)Value

'清空改小区-建筑的费用明细

Sql = "delete  from fymxb where 小区ID=" & XQID & " AND 建筑ID = " & JZID

cONnExecute Sql

Const kshh = 7

hh = kshh

Do While Cells(hh, 3)Value > 0

FYID = Cells(hh, 3)Value

FBXZ = Cells(hh, 11)Text

For i = 1 To 31

SARR(i) = Round(Cells(hh, 13 + i - 1)Value, 2)

Next i

Sql = Sql & "," & SARR(i)

Next i

Sql = Sql & " )"

cONnExecute Sql

hh = hh + 1

Loop

End Sub

你这样循环查询是不科学了，上万记录会慢死，应该一次性读出所有数据，然后去填写：

'建立已经字典，把数据库内容存入字典

set daList = CreateObject("ScriptingDictionary")

rsOpen "select DA,B1,S1,M1,St1,R1 from `A`", conn

Do While Not rsEOF()

     daListAdd rs(1), Array(rs(2),rs(3),rs(4),rs(5),rs(6))

     rsMoveNext

Loop

'填写EXCEL表

for i=2 to Cells(rowscount, "D")End(xlUp)Row

    da = Cells(i,"D")

    if daListExists(da) then

        Cells(i,"E")resize(5,1) = daList(da)

    else

        Cells(i,"E")resize(5,1) = Empty

    end if

next i

要通过EXCEL查询指定数据库中的含 有指定字段的表名时，首先得知道查询SQL，查询SQL如下：

SELECT TABLE_NAME FROM INFORMATION_SCHEMACOLUMNS where COLUMN_NAME='字段名'

如果要写成VBA的话，下面给你一段我写的宏，测试过了：

－－－－－－－－－－－

Sub 宏7()

' 宏7 宏

ApplicationCutCopyMode = False

With ActiveSheetListObjectsAdd(SourceType:=0, Source:= _

"ODBC;DRIVER=SQL Server;SERVER=服务器IP;UID=sa;;APP=Microsoft Office 2016;WSID=GUESS;DATABASE=要查询的数据库名" _

, Destination:=Range("$A$1"))QueryTable

CommandType = xlCmdSql

CommandText = Array( _

"SELECT TABLE_NAME" & Chr(13) & "" & Chr(10) & "FROM 要查询的数据库名INFORMATION_SCHEMACOLUMNS" & Chr(13) & "" & Chr(10) & "WHERE (COLUMN_NAME='要查询的字段名')")

RowNumbers = False

FillAdjacentFormulas = False

PreserveFormatting = True

RefreshOnFileOpen = False

BackgroundQuery = True

RefreshStyle = xlInsertDeleteCells

SavePassword = False

SaveData = True

AdjustColumnWidth = True

RefreshPeriod = 0

PreserveColumnInfo = True

Dim chars As String

Dim rndstr As String

chars = "ABCDEFGHJKLMNPQRSTUVWXYZ0123456789"

Randomize

For i = 1 To 6

rndstr = rndstr & Mid(chars, Int(Rnd()  Len(chars) + 1), 1)

Next

ListObjectDisplayName = rndstr

Refresh BackgroundQuery:=False

End With

End Sub

最后结果如下图：

你大概弄错了，数据库不存在什么最后

空行

，你指的多半是插入 *** 作，如果是的话，执行

sql语句

（假定你的第三列

字段名

为name)

str="insert

into

wdgj21(name)

values('"

&

Ar

&

"')"

（怎么执行不用偶说吧）当然如果你用addnew之类来替代上面这个也是可以的。

取出数据跟这个是差不多的，假定你的数据库中的name2列中包括这个ar的内容，你想取出那一行的name的值，

str="select

top

1

name

from

wdgj21

where

name2

like

'%"

&

Ar

&

"%'"

用ADODBRecordset打开就可以取到结果了。

以上就是关于excel vba如何实现通过表一对表二的数据进行查询与修改，表一为查询表，表二为数据库表全部的内容，包括:excel vba如何实现通过表一对表二的数据进行查询与修改，表一为查询表，表二为数据库表、在EXCEL中使用VBA连接数据库查询，每运行一次，进程就多一个，请问什么原因，如何改善、用VBA如何获取access数据库中字段的数据类型等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！