Страницы: 1
RSS
Получение данных из закрытой книги
 
Добрый день.

Не могу допетрить , как лучше  сделать . Имеется закрытая книга на сетевом диске, из нее мне нужно вытащить данные по критерии в active.workbook .
Выполнить левый ВПР по типу ( индекс+поискпоз).

Вариантов тут два
1)открывать книгу внутри процедуры, загонять все в массивы сравнивать , записывать найденные данные в  active.workbook  , закрывать книгу сервера.
2) UDF из закрытой книги.

Я пошел по второму пункту, но предварительно выгружал данные в активную книгу в создаваемый  временный лист, и с помощью UDF по типу Vlookups, далее хотел получить данные столбца A файла на сервере, после удалить вспомогательный лист. Но насколько понимаю можно сразу вытащить нужные данные напрямую...

Внести данные нужно в файле "Критерии" ,в желтый столбец. Данные нужны из столбца A файла "вытащить данные"
Файл "критерии" active.workbook
Файл "вытащить данные" - файл на сетевом диске

P.s  пример кода не будет работать , он из конкретного проекта. Сама суть.....
Код
Sub данные_close_book()
    Dim sPath As String, sFile As String, sShName As String
    Application.DisplayAlerts = 0
    sPath = "D:\Excle не трогать\8_Visual Managment\"    '"
    sFile = "вытащить данные.xlsx"    '"
    sShName = "Test"    '"


    Worksheets.Add.Name = "Test"
    With Range("a1:N10000")
        .Formula = "='" & sPath & "[" & sFile & "]" & sShName & "'!" & "C5"    '"
        '"A1" - указывается начальная ячейка диапазона, из которого необходимо получить значения

        .Value = .Value

    End With

    Application.DisplayAlerts = 1
End Sub

Sub zapolnit()
    Application.DisplayAlerts = 0
    Dim k           As Long
    k = ActiveWorkbook.Sheets("Критерии").Cells(Rows.Count, "a").End(xlUp).Row
    With Range("b2:b" & k)
        .FormulaR1C1 = "=INDEX(Test!R1C1:R10000C324,MATCH(--Sheet1!RC6,Test!R1C12:R10000C12,0),1)"  ' тут она не корректна,для конкретного примера была верной
        .Value = .Value   '  тут я ловил ошибку Overfloor ,переполнение памяти....
        ActiveWorkbook.Sheets("Test").Delete
        Application.DisplayAlerts = 1
    End With

End Sub
 
Что-то не очень понятно, что хотите. Что не получается-то?
Если хотите без вспомогательного листа, то в той же статье, из которой взята основа кода, есть вариант Get_Value_From_Close_Book2 с использованием массива vData - его напрямую можно запихнуть в ВПР через WorksheetFunction или написать свою функцию аналогичного функционала для работы с массивом.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий(The_Prist) Щербаков,  не соображаю как правильно параметры подставить в sub-e  и потом ее вызвать правильно в процедуре...


Код
    Sub Get_Value_From_Close_Book2()
4:    Dim sShName As String, sAddress As String, vData
5:    Dim objCloseBook As Object
6:
7:    Application.ScreenUpdating = False
8:    Set objCloseBook = GetObject("D:\Excle не трогать\8_Visual Managment\****.xlsx")
9:    sAddress = "C6:N10000"
10:
11:    vData = objCloseBook.Sheets("****").Range(sAddress).Value
12:    objCloseBook.Close False
13:
14:    If IsArray(vData) Then
15:        [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
16:    Else
17:        [A1] = vData
18:    End If
19:
20:    Application.ScreenUpdating = True
21: End Sub

    Function VPR(Table As Variant, SearchColumnNum As Long, SearchValue As Variant, _
                N As Long, ResultColumnNum As Long)
25:    Dim i As Long, iCount As Long
26:    Select Case TypeName(Table)    'vdata  вместо table
        Case "Range"
28:            For i = 1 To Table.Rows.Count    'vdata  вместо table
29:                If Table.Cells(i, SearchColumnNum) = SearchValue Then
30:                    iCount = iCount + 1
31:                End If
32:                If iCount = N Then
33:                    VLOOKUP2 = Table.Cells(i, ResultColumnNum)
34:                    Exit For
35:                End If
36:            Next i
37:        Case "Variant()"
38:            For i = 1 To UBound(Table)
39:                If Table(i, SearchColumnNum) = SearchValue Then iCount = iCount + 1
40:                If iCount = N Then
41:                    VLOOKUP2 = Table(i, ResultColumnNum)
42:                    Exit For
43:                End If
44:            Next i
45:    End Select
46: End Function
Изменено: restation - 21.07.2020 21:29:07
Страницы: 1
Наверх