MS Access 2010中两个开放式电子表格之间动态VLookup的VBA代码

时间:2012-03-14 18:02:36

标签: vba automation access-vba ms-access-2010

我对工作项目采取了不同的方法,而且我遇到了障碍。在回到S.O.之前,我已经谷歌了解了我可以想到谷歌并搜索过多个论坛的所有内容。要求更多的帮助。我在Access中有一个表单,让用户输入客户/部门组合,检查以确保该客户的现有文件路径,然后打开Excel模板文件并将其保存到具有客户特定文件名的正确文件夹中。这一切似乎都很好。这是让我完全难过的部分。下一部分是打开两个excel文件分配,工作簿作为变量xlWB1和xlWB2,工作表作为xlWS1和xlWS2(Sheet1)。我需要从xlWB1.xlWS1。(单元格D2)开始,并根据xlWB2.xlWS2.Range(D2:D1937)范围内的单元格值对该单元格的值(项目编号)执行VLookup。我希望在启动VLookup之前计算每个工作表中的总行数,以便我可以将该值赋给变量并使用该变量来定义范围的底部。如果答案很简单,我会提前道歉。我从来没有尝试过使用VBA从Access执行任何Excel操作,所以我也在努力学习语法。如果我的问题不清楚或者您是否还需要其他信息,请告诉我。我在下面粘贴了我的起始代码。

任何人都需要使用更新的代码!谢谢大家的帮助!!

Sub modExcel_SixMonth()

    Const WB_PATH As String = "\\FMI-FS\Users\sharp-c\Desktop\TestDir\"

    Dim xlApp As Excel.Application

    Dim xlWB As Excel.Workbook
    Dim xlWS As Excel.Worksheet
    Dim xlRng As Excel.Range
    Dim rCount As Long

    Dim xlWB2 As Excel.Workbook
    Dim xlWS2 As Excel.Worksheet
    Dim rCount2 As Long
    Dim sFormula As String

    Dim i As Long
    Dim xlSheetName As String
    Dim bolIsExcelRunning As Boolean

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
    Else
        bolIsExcelRunning = True
    End If

    xlApp.Visible = False

    Set xlWB = xlApp.Workbooks.Open(WB_PATH & "acct 900860 Kentucky RSTS.xlsx")
    Set xlWS = xlWB.Sheets(1)

    Set xlWB2 = xlApp.Workbooks.Open(WB_PATH & "acct 900860 six months.xlsx")
    Set xlWS2 = xlWB2.Sheets(1)

    xlSheetName = xlWS2.Name

    ' rCount: RSTS Row Count
    rCount = xlWS.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
    Debug.Print "rCount : " & rCount

    ' rCount2: 6 Months Row Count
    rCount2 = xlWS2.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
    Debug.Print "rCount2 : " & rCount2

    xlWS.Activate

    With xlWS
        For i = 2 To rCount

            sFormula = "=VLOOKUP(C" & i & ", '" & WB_PATH & "[" & "acct 900860 six months.xlsx" & "]" & _
                       xlSheetName & "'!$D$2:$D$" & rCount2 & ", 1, 0)"

            Debug.Print sFormula
            .Range("D" & i).Formula = sFormula
            DoEvents
        Next
    End With

    xlWB.Save

    xlWB2.Close False                       'Closes WB Without Saving Changes
    Set xlWB2 = Nothing

    Set xlWS = Nothing
    xlWB.Close
    Set xlWB = Nothing

    If Not bolIsExcelRunning Then
    xlApp.Quit
    End If

    Set xlApp = Nothing

End Sub

2 个答案:

答案 0 :(得分:3)

我认为这可能更接近您的需求。两个工作簿只需要一个excel的单个实例......

Sub modExcel_SixMonth()

Const WB_PATH As String = "C:\Documents and Settings\Chris\Desktop\TestDir\"

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Dim xlRng As Excel.Range
Dim rCount As Long

Dim xlWB2 As Excel.Workbook
Dim xlWS2 As Excel.Worksheet
Dim xlRng2 As Excel.Range
Dim rCount2 As Long
Dim sFormula As String

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True

    Set xlWB = xlApp.Workbooks.Open(WB_PATH & "acct 900860 Kentucky RSTS.xlsx")
    Set xlWS = xlWB.Sheets(1)

    Set xlWB2 = xlApp.Workbooks.Open(WB_PATH & "acct 900860 six months.xlsx")
    Set xlWS2 = xlWB2.Sheets(1)

    ' rCount: RSTS Row Count
    rCount = xlWS.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count - 1
    Debug.Print "rCount : " & rCount

    ' rCount2: 6 Months Row Count
    rCount2 = xlWS2.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count - 1
    Debug.Print "rCount2 : " & rCount2

    sFormula = "=VLOOKUP(C2," & xlWS2.Range("D2:D1937").Address(True, True, , True) & _
                ",1,FALSE)"

   Debug.Print sFormula
   With xlWS
       .Range("D2").Formula = sFormula
   End With

End Sub

答案 1 :(得分:1)

您是否尝试过使用相同的应用程序对象?我相信这是对此问题的评论。

此外,如果这不起作用,您可以使用范围对象的find方法。即

XLWB2.Range("Your range here").find(XLWB1.Range( _
    "Cell containing value you're looking for").Value,lookat:=xlwhole)