Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Парсинг vlookup ' oм из одного документа в другие в цикле - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Парсинг vlookup ' oм из одного документа в другие в цикле (Макросы/Sub)
Парсинг vlookup ' oм из одного документа в другие в цикле
ant6729 Дата: Пятница, 03.11.2017, 17:36 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

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(8Kb)


Сообщение отредактировал ant6729 - Пятница, 03.11.2017, 18:17
 
Ответить
СообщениеЕсть конкретный документ 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]

Автор - ant6729
Дата добавления - 03.11.2017 в 17:36
ant6729 Дата: Пятница, 03.11.2017, 17:37 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

Excel 2010
Условные файлы в директории, в который проставляется возраст
К сообщению приложен файл: 6813560.xlsx(8Kb)


Сообщение отредактировал ant6729 - Пятница, 03.11.2017, 17:38
 
Ответить
СообщениеУсловные файлы в директории, в который проставляется возраст

Автор - ant6729
Дата добавления - 03.11.2017 в 17:37
ant6729 Дата: Пятница, 03.11.2017, 17:37 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

Excel 2010
Второй файл из директории, в который проставляется возраст
К сообщению приложен файл: 1322683.xlsx(8Kb)


Сообщение отредактировал ant6729 - Пятница, 03.11.2017, 17:39
 
Ответить
СообщениеВторой файл из директории, в который проставляется возраст

Автор - ant6729
Дата добавления - 03.11.2017 в 17:37
ant6729 Дата: Воскресенье, 05.11.2017, 20:16 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

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 ило все?
 
Ответить
СообщениеДобрый вечер всем еще раз, я воспроизвел логику в этом коде:
[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 в 20:16
ant6729 Дата: Воскресенье, 05.11.2017, 21:23 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

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]
 
Ответить
СообщениеВсе... допилил...

[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]

Автор - ant6729
Дата добавления - 05.11.2017 в 21:23
Pelena Дата: Воскресенье, 05.11.2017, 21:29 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 11755
Репутация: 2596 ±
Замечаний: 0% ±

Excel 2010, 2016 & 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]


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЗачем каждый раз в цикле открывать/закрывать 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]

Автор - Pelena
Дата добавления - 05.11.2017 в 21:29
ant6729 Дата: Воскресенье, 05.11.2017, 23:08 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 356
Репутация: -6 ±
Замечаний: 60% ±

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

Автор - ant6729
Дата добавления - 05.11.2017 в 23:08
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Парсинг vlookup ' oм из одного документа в другие в цикле (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!