ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
123
返回列表 发新帖
楼主: 余茂贤

[求助] 如何在EXCEL单元格中调用ACCESS数据库中对应字段的数据?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-1-4 11:50 | 显示全部楼层
下面的语句是我的一个文件的功能,类似你的要求,可以参考。

ACCESS数据库:PIM_Base.mdb放在公共盘,国别码清单放在数据库的CO_NO表内
选择EXCEL文件的 Sh_Input表后,在单元格J1内,自动按数据库CO_NO表内的国别清单填写序列,ACCESS数据库更新,单元格序列就自动更新。

Private Sub Worksheet_Activate()
Dim iArr_Data()
myDatabase = "PIM_Base.mdb"
Open_AccessData
With Sh_Input
    .AutoFilterMode = False
    .Range("A7:K7").AutoFilter
    For x = 2 To 10
      If .Cells(1048576, x).End(xlUp).Row >= iRow_Data Then iRow_Data = .Cells(1048576, x).End(xlUp).Row
    Next
    iCO_All = .Range("D6").Value
    If iRow_Data > 7 Then
        niArr_Data = iRow_Data - 7
        iArr_Data() = .Range("J8:K" & iRow_Data)
    End If
    .Range("A" & iRow_Data + 1 & ":K1048576").Clear

    iList_Country = Empty
'//=====提取国别代码资料=====//
    strSQL = "Select CO_NO,CO_Name From List_Country Order By CO_NO"
    rstAnswers.Open strSQL, cnnAccess
    Do Until rstAnswers.EOF = True
        If iList_Country = Empty Then iList_Country = rstAnswers(0) & "_" & rstAnswers(1) Else iList_Country = iList_Country & "," & rstAnswers(0) & "_" & rstAnswers(1)
        rstAnswers.Movenext
    Loop
    rstAnswers.Close
'//====================================//
    With .Range("J1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=iList_Country
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "错误信息"
        .InputMessage = ""
        .ErrorMessage = "请选择正确的目的国别!"
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    .Range("J1").Copy .Range("D6")
    .Range("D6").Value2 = iCO_All
    If niArr_Data <> 0 Then
        .Range("J1").Copy .Range("J8:J" & iRow_Data)
        .Range("J8:J8").Resize(niArr_Data) = iArr_Data()
    Else
        .Range("A1:K1").Copy .Range("A8:K107")
    End If
   
    iCustomer = .Range("D3").Value
    iList_Customer = Empty

'//=====提取客户资料=====//
    strSQL = "Select Customer_SN & '.' & Customer_Code & '_' & Customer_Name From List_Customer Order By Customer_SN"
    rstAnswers.Open strSQL, cnnAccess
    Do Until rstAnswers.EOF = True
        If iList_Customer = Empty Then iList_Customer = rstAnswers(0) Else iList_Customer = iList_Customer & "," & rstAnswers(0)
        rstAnswers.Movenext
    Loop
    rstAnswers.Close
'//====================================//
    Set rstAnswers = Nothing
    Set cnnAccess = Nothing
    With .Range("D3").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=iList_Customer
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "错误信息!"
        .InputMessage = ""
        .ErrorMessage = "请选择正确的贸易商名称!"
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
    .Range("D3").Value2 = iCustomer
    .Range("B6").Copy
    .Range("D6").PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
End With
Erase iArr_Data()
End Sub



您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-19 13:39 , Processed in 0.035964 second(s), 6 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表