Как получить значение из ячейки в других книгах на основе динамического пути к файлу

Question

Я хотел бы получить значение ячейки из других рабочих книг в свой основной файл.

Эти файлы находятся в одной папке G:\Data\xxx\yyy, а имя файла - идентификатор клиента.

т.е. путь к файлу может быть G:\Data\xxx\yyy\123 или G:\Data\xxx\yyy\234 И значение, которое я хотел бы извлечь из этих книг, находится в Sheet ABC ячейке J55.

Таким образом, формула I, введенная в ячейку, имеет вид = G:\Data\xxx\yyy [123.xlsm]'!$J$55

В главном файле у меня есть список идентификаторов клиентов в столбце A, и я хотел бы получить значение из ячейки J55 в других книгах. создать динамический путь к файлу, чтобы получить числа, и вставить его в столбец B.

Однако я попытался объединить связь с «КОНКАТЕНАТ» и «G», но не получилось.

Я попробовал косвенную функцию, но она требует, чтобы я открывал справочники, которые не идеальны.

Это способ для меня получить цифры?

VBA-кодирование приветствуется.

Answer 1

Это решение, которое можно запустить из Excel VBA. Я допускаю, что это может быть излишним решением вашей проблемы, но он проверит столбец A для значений и заполнит столбец B, если он пуст от J55 выбранных рабочих книг, не открывая ни одну из них. Предполагается, что у вас есть Microsoft Access как часть вашего офисного пакета, вы работаете в 64-битной версии Windows, файлы, из которых вы извлекаете данные, имеют расширение .xlsx, а данные, которые вы хотите получить с J55, находятся на «Sheet1». Если какое-либо из этих предположений неверно, пожалуйста, дайте мне знать, так как код может быть легко скорректирован.

Из предоставленной вами информации кажется, что путь к файлу для всех файлов, к которым вы хотели бы получить доступ, является статическим (G: \ Data \ xxx \ yyy), и только имя файла является динамическим (имя файла = идентификатор клиента # из колонки А). Вам нужно будет сделать ссылку на Microsoft XML v6.0 и Microsoft ActiveX Data Objects x.x Library.

Код ниже в основном вырезан и вставлен из другого проекта, который я написал. Это все еще должно быть проверено. Я бы посоветовал добавить некоторую обработку ошибок и обычный vba-код, улучшающий производительность, например отключить обновление экрана.

Option Explicit

Public Sub Test()

    'Folder where Wb live
    Const FilePath As String = "G:\Data\xxx\yyy\"

    'Command string
    Const request_SQL As String = "SELECT * FROM [Sheet1$]"

    'Get last row
    Dim LastRow As Long
    With ActiveWorkbook.ActiveSheet
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    'Create Array from Main worksheet
    Dim MainWsArray As Variant
    MainWsArray = ActiveWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(LastRow, 2))


    Dim FullFileName As String

    'Create a connection to be used throughout the loop
    Dim Cnx As ADODB.Connection
    Set Cnx = New ADODB.Connection

    Dim CustomerId As Long
    Dim RowCounter As Long
    Dim Rst As ADODB.Recordset
    Set Rst = New ADODB.Recordset

    'Loop through Array to get values
    For RowCounter = 1 To LastRow
        If MainWsArray(2, RowCounter) = vbNullString Then
            CustomerId = MainWsArray(1, RowCounter).Value
            FullFileName = FilePath & CustomerId
            AssignCnx Cnx, FullFileName

            'Create RecordSet

            If OpenRecordset(Rst, request_SQL, Cnx) Then
                MsgBox "Unable to open Recordset. " & CustomerId
            End If

            'Use recordset to get data from file.
            Rst.Move 54
            MainWsArray(2, RowCounter) = Rst.Fields(10)
        End If
        Rst.Close
        Cnx.Close
    Next RowCounter

    ActiveWorkbook.ActiveSheet.Range(Cells(1, 2), Cells(LastRow, 2)) = MainWsArray()

    If Not Rst Is Nothing Then Set Rst = Nothing
    If Not Cnx Is Nothing Then Set Cnx = Nothing
End Sub

Public Sub AssignCnx(ByRef Cnx As ADODB.Connection, ByVal FullFileName As String)

    'Connection
    With Cnx
        .Provider = "Microsoft.ACE.OLEDB.12.0" 'or "Microsoft.Jet.OLEDB.4.0" for 32bit
        .ConnectionString = "Data Source=" & FullFileName & _
           ";Extended Properties='Excel 12.0 xml;HDR=NO;IMEX=1;Readonly=False'"
        .Open
    End With

End Sub

Private Function OpenRecordset(ByRef Rst As ADODB.Recordset, ByVal request_SQL As String, ByRef Cnx As ADODB.Connection) As Boolean
    'Error Trapping for the RecordSet

    Dim backupRequestString As String
    On Error Resume Next
    Rst.Open request_SQL, Cnx, adOpenForwardOnly, adLockReadOnly, adCmdText
    If Err.Number = 0 Then
        OpenRecordset = False
        Exit Function
    Else
        Rst.Close
        OpenRecordset = True
        Exit Function
    End If
End Function

Надеюсь, вы найдете это полезным. Если это немного, есть другие способы связать рабочие книги с главным файлом из Excel без VBA. Прошло много времени с тех пор, как я делал это таким образом. Удачи.