Парсинг vlookup ' oм из одного документа в другие в цикле

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Парсинг vlookup ' oм из одного документа в другие в цикле (Макросы/Sub)

ant6729

Дата: Пятница, 03.11.2017, 17:36 | Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Есть конкретный документ N.xlsx[vba]

Код

"G:\N.xlsx"

[/vba]
Есть другие конкретные документы в директории [vba]

Код

"G:\1\"

[/vba]

В каждый из документов из [vba]

Код

"G:\1\"

[/vba] нужно вставить данные из [vba]

Код

"G:\N.xlsx"

[/vba]

Пробую делать это все vlookup ' ом
Происходит путаница с директориями и как их прописать.
Прилагаю файлы.
Вот мой код.

Подскажите, пожалуйста, как прописать, чтобы в каждый документ проставлялись данные(возраст) из одного?

[vba]

Код

Sub FaisomObTable2()
    Dim wb_ As Workbook
        Application.ScreenUpdating = False

    fp_ = "G:\1\"

    fv_ = "G:\N.xlsx"

    fvn_ = Dir(fv_)

    fn_ = Dir(fp_ & "*.xls*", vbNormal)
    On Error Resume Next
    Do While fn_ <> ""
    Set wb_ = GetObject(fp_ & fn_)

    On Error Resume Next
    With wb_.Sheets("Лист1")
                   .Cells(5, 4) = Application.WorksheetFunction.VLookup(Cells(1, 1), fvn_.Range("B2:С1000"), 2, False)
    End With

        wb_.Close False
        lr_ = Empty
        fn_ = Dir()
    Loop

End Sub

[/vba]

К сообщению приложен файл: 3900715.xlsx (8.0 Kb)

Сообщение отредактировал ant6729 - Пятница, 03.11.2017, 18:17

Ответить

ant6729

Дата: Пятница, 03.11.2017, 17:37 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Условные файлы в директории, в который проставляется возраст

К сообщению приложен файл: 6813560.xlsx (7.9 Kb)

Сообщение отредактировал ant6729 - Пятница, 03.11.2017, 17:38

Ответить

ant6729

Дата: Пятница, 03.11.2017, 17:37 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Второй файл из директории, в который проставляется возраст

К сообщению приложен файл: 1322683.xlsx (7.9 Kb)

Сообщение отредактировал ant6729 - Пятница, 03.11.2017, 17:39

Ответить

ant6729

Дата: Воскресенье, 05.11.2017, 20:16 | Сообщение № 4

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Добрый вечер всем еще раз, я воспроизвел логику в этом коде:
[vba]

Код

Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

myPath = "G:\1\"
myPath2 = "G:\"
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

  myExtension = "*.xls*"
  myExtension2 = "N.xlsx"

  myFile = Dir(myPath & myExtension)
  myFile2 = Dir(myPath2 & myExtension2)

  Do While myFile <> ""

      Set wb2 = Workbooks.Open(Filename:=myPath2 & myFile2)
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

      DoEvents


wb.Worksheets(1).Select
n = Cells(1, 1).Value
wb.Worksheets(1).Cells(5, 5).Value = Application.WorksheetFunction.VLookup(n, wb2.Worksheets(1).Range("A1:B100"), 2, False)

wb.Close SaveChanges:=True
wb2.Close SaveChanges:=True

      DoEvents

      myFile = Dir
'      myFile2 = Dir
  Loop

ResetSettings:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

[/vba]

Но оно мне циклит только один раз на один документ.
Остальные документы открывать отказывается, вылетает.

Подскажите, пожалуйста, как сделать, чтобы оно все таки vlookup ило все?

Ответить

ant6729

Дата: Воскресенье, 05.11.2017, 21:23 | Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Все... допилил...

[vba]

Код

Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim wb2 As Workbook
Dim myPath As String
Dim myPath2 As String
Dim myFile As String
Dim myFile2 As String
Dim myExtension As String
Dim myExtension2 As String

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

myPath = "G:\1\"
myPath2 = "G:\"
NextCode:

  myPath = myPath
  myPath2 = myPath2

  If myPath = "" Then GoTo ResetSettings
  If myPath2 = "" Then GoTo ResetSettings

  myExtension = "*.xls*"
  myExtension2 = "N.xlsx"

  myFile2 = Dir(myPath2 & myExtension2)
  myFile = Dir(myPath & myExtension)




  Do While myFile <> ""

      Set wb = Workbooks.Open(Filename:=myPath & myFile)
      DoEvents

wb.Worksheets(1).Select
n = Cells(1, 1).Value
Set wb2 = Workbooks.Open(Filename:=myPath2 & myFile2)
On Error Resume Next
wb.Worksheets(1).Cells(5, 5).Value = Application.WorksheetFunction.VLookup(n, wb2.Worksheets(1).Range("A1:B100"), 2, False)

wb.Close SaveChanges:=True
wb2.Close SaveChanges:=True

      DoEvents

      myFile = Dir
'      myFile2 = Dir
  Loop

ResetSettings:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

[/vba]

Ответить

Pelena

Дата: Воскресенье, 05.11.2017, 21:29 | Сообщение № 6

Группа: Админы

Ранг: Местный житель

Сообщений: 19184

Репутация: 4420 ±

Замечаний: ±

Excel 365 & Mac Excel

Зачем каждый раз в цикле открывать/закрывать wb2?
Вариант
[vba]

Код

Sub LoopAllExcelFilesInFolder()
    Dim wb As Workbook
    Dim wb2 As Workbook
    Dim myPath As String
    Dim myPath2 As String
    Dim myFile As String
    Dim myFile2 As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim n

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    myPath = "G:\1\"
    myPath2 = "G:\"
    myFile2 = "N.xlsx"
    Set wb2 = Workbooks.Open(Filename:=myPath2 & myFile2)
    myExtension = "*.xls*"

    myFile = Dir(myPath & myExtension)
    Application.DisplayAlerts = False
    Do While myFile <> ""
        Set wb = Workbooks.Open(Filename:=myPath & myFile)
        With wb.Worksheets(1)
            n = .Cells(1, 1).Value
            .Cells(4, 5).Value = Application.WorksheetFunction.VLookup(n, wb2.Worksheets(1).Range("B1:C100"), 2, False)
        End With
        wb.Close SaveChanges:=True
        myFile = Dir
    Loop
    wb2.Close SaveChanges:=True
    Application.DisplayAlerts = False

ResetSettings:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

ant6729

Дата: Воскресенье, 05.11.2017, 23:08 | Сообщение № 7

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Наверное, перестраховывался уже...во избежание, если система начнет брать данные с активного листа не той книги.
Но, да... по 100 раз открывать - закрывать - не нужно.

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Парсинг vlookup ' oм из одного документа в другие в цикле (Макросы/Sub)

Страница 1 из 1
1