如何将Excel表单数据自动导入导出Access数据库

如何将Excel表单数据自动导入导出Access数据库,第1张

用vba可以实现。
下面提供我给客户写的程序一部分,你可以参考。
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 = "INSERT INTO fymxb(小区ID,建筑ID,费用ID,分包性质,工作量,单价合计_中标,人工费_中标, 主材费_中标, 辅材费_中标, 机械费_中标, 管理费_中标, 利润_中标,规费_中标,税金_中标,合价_中标,单价合计_标准成本,人工费_标准成本,主材费_标准成本,辅材费_标准成本,机械费_标准成本,管理费_标准成本,利润_标准成本,规费_标准成本,税金_标准成本,合价_标准成本,单价合计_实际成本,人工费_实际成本,主材费_实际成本,辅材费_实际成本,机械费_实际成本,管理费_实际成本,利润_实际成本,规费_实际成本,税金_实际成本,合价_实际成本) VALUES (" & XQID & ", " & JZID & ", " & FYID & ", '" & FBXZ & "'"
For i = 1 To 31
Sql = Sql & "," & SARR(i)
Next i
Sql = Sql & " )"
cONnExecute Sql
hh = hh + 1
Loop
End Sub
Sub FYMXDc() '导出费用明细
Dim jgarr(1 To 5, 1 To 2) As String '存放各级名称:1-id 2-名称
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
Const kshh = 7
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
'清空EXCEL
Range("A7:AQ1000")ClearContents
Sql = "SELECT from fymxb where 小区ID=" & XQID & " AND 建筑ID = " & JZID
rstOpen Sql, cONn, adopenkeyset, adlockoptimistic
If rstRecordCount > 0 Then
ARR = rstGetRows
Else
Exit Sub
End If
rstClose
Set rst = Nothing
hh = UBound(ARR, 2)
lh = UBound(ARR, 1)
For i = 0 To hh
Cells(kshh + i, 2) = ARR(0, i) 'ID
Cells(kshh + i, 3) = ARR(3, i) '费用ID
myid = ARR(3, i)
For j = 4 To 36
Cells(kshh + i, j + 7) = ARR(j, i) '分包性质后
Next j
'rstClose
'Set rst = Nothing
Sql = "select 名称,fid,SID,LEV,特征描述 from kmmxb where id = " & myid
rstOpen Sql, cONn, adopenkeyset, adlockoptimistic
ARR2 = rstGetRows
myfid = ARR2(1, 0)
mysid = ARR2(2, 0)
mylev = ARR2(3, 0)
mytzms = ARR2(4, 0)
MYSIDARR = Split(mysid, "-")
For k = 1 To mylev
jgarr(k, 1) = MYSIDARR(k - 1)
Next k
rstClose
For k = 1 To mylev
Sql = "select 名称 from kmmxb where id = " & jgarr(k, 1)
rstOpen Sql, cONn, adopenkeyset, adlockoptimistic
ARR2 = rstGetRows
jgarr(k, 2) = ARR2(0, 0)
rstClose
Next k
HH2 = kshh + i
'Cells(hh2, 3) = myid
Cells(HH2, 1) = myfid
For k = 1 To mylev
Cells(HH2, 4 + k - 1) = jgarr(k, 2)
Next k
Cells(HH2, 9) = mytzms
Next i
Call gs
End Sub

以上就是关于如何将Excel表单数据自动导入导出Access数据库全部的内容,包括:如何将Excel表单数据自动导入导出Access数据库、、等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!

欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/sjk/10180977.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-06
下一篇 2023-05-06

发表评论

登录后才能评论

评论列表(0条)

保存