Код VBA для динамического VLookup между двумя открытыми электронными таблицами из MS Access 2010

Я выбрал другой подход к рабочему проекту и уперся в стену. Я загуглил все, что я мог придумать, и просмотрел несколько форумов, прежде чем вернуться к С.О. просить о дополнительной помощи. У меня есть форма в Access, которая позволяет пользователям вводить комбинацию «клиент/подразделение», проверяет, существует ли существующий путь к файлу для этого клиента, затем открывает файлы шаблонов Excel и сохраняет их в правильной папке с именем файла для конкретного клиента. Кажется, все это работает нормально. Вот та часть, которая меня полностью поставила в тупик. Следующей частью этого будет открытие двух назначенных файлов Excel, рабочих книг как переменных xlWB1 и xlWB2 и рабочих листов как xlWS1 и xlWS2 (Sheet1). Мне нужно начать с xlWB1.xlWS1.(ячейка D2) и выполнить VLookup для значения (номер элемента) этой ячейки по значениям ячеек в диапазоне xlWB2.xlWS2.Range(D2:D1937). Я надеялся подсчитать общее количество строк на каждом листе перед запуском VLookup, чтобы я мог присвоить это значение переменной и использовать эту переменную для определения нижнего предела диапазона. Я заранее извиняюсь, если ответ на это что-то простое. Я никогда не пытался выполнять какие-либо операции в Excel из Access с помощью VBA, поэтому я также борюсь с синтаксисом. Пожалуйста, дайте мне знать, если мой вопрос неясен или если вам нужна дополнительная информация. Я вставил свой начальный код ниже.

ОБНОВЛЕННЫЙ КОД НА СЛУЧАЙ, КТО-ТО ДОЛЖЕН ЕГО ИСПОЛЬЗОВАТЬ! СПАСИБО ВСЕМ ЗА ПОМОЩЬ!!

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

automation vba ms-access-2010 ms-access
person CSharp821    schedule 14.03.2012    source источник
comment
Хотя у меня нет прав на редактирование (я пытался, вот как я узнал), могу ли я порекомендовать вам сделать несколько разрывов строк в вопросе, чтобы его (намного) было легче читать?   -  person mkingston    schedule 15.03.2012

Ответы (2)


arrow_upward
3
arrow_downward

Я думаю, что это может быть ближе к тому, что вам нужно. Нужен только один экземпляр 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
person Tim Williams    schedule 15.03.2012
comment
Опять же, я ценю помощь! Это именно то, что мне было нужно. Теперь мне нужно изучить аргументы в пользу Vlookup, чтобы понять, почему он работает!! Большое спасибо!! - person CSharp821; 15.03.2012

arrow_upward
1
arrow_downward

Вы пытались использовать тот же объект приложения? Я считаю, что это был комментарий к этому вопросу ранее.

Кроме того, если это не сработает, вы можете использовать метод find объекта диапазона. т.е.

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