Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Выгрузка данных с другого файла с помощью VLOOKUP
 
#1
29.05.2017 14:29:02
Добрый день, всем
В форуме много примеров по VLOOKUP, но по своей задаче схожей не мог найти, прошу строго не судить

Ребята подскажите, имеется нижеуказанный код и он рабочий.
Код
VBA Sub zhas()
Dim i As Long, f As Long, s As String, n As Long
        For i = 2 To 7
        n = 1
        For f = 2 To 5
            Cells(i, f) = Application.VLookup(Cells(i, 1).Value, Range("Книга2!A:E"), n + 1, False)
            n = n + 1
        Next f
    Next i
    MsgBox "Загрузка завершена!"
End Sub

Есть одно но, в исходном файл данные находятся хаотично то есть (согласно приложенному файлу в листе "Книга2")
Должность,Отдел,Департамент,ID код,Имя,Фамилия
А как сделать чтобы из 6 колонн необходимо только 4 загружались, а порядочность и необходимые колонные были следующим образом отображались в Листе "Лист1":
Фамилия, Имя, Отдел, Должность
Второй момент, в случае если выгружаемые данные были в другом файле как можно сделать ссылку (по вышеуказанному сценарию), например если наименование файлы было бы "Книга2",
не могли бы в приложенном коде прописать пожалуйста

Спасибо
Изменено: krom - 29.05.2017 16:51:13
 
 
 
#2
29.05.2017 14:37:53
если уж настаиваете на application.vlookup, то можно так
Код
Sub zhas()
Dim i As Long, f As Long, s As String, n As Long, sh As Worksheet
Set sh = Worksheets("Книга2")
    For i = 2 To 7
        For f = 2 To 5
        n = sh.Rows(1).Find(what:=Cells(1, f).Value).Column
            Cells(i, f) = Application.VLookup(Cells(i, 1).Value, sh.Range("A:E"), n, False)
        Next f
    Next i
    MsgBox "Конец!", vbInformation, "Конец"
End Sub
 
 
 
#3
29.05.2017 14:41:59
yozhik,

Спасибо большое, а не подскажите как я писал раннее, такой же сценарий только исходные данные будут находится в закрытом и отдельном файле
Очень надо  
 
 
 
#4
29.05.2017 14:44:00
закрытый файл надо сначала открыть. забрать данные и закрыть. нужен путь к файлу, наименование листа с данными
 
 
 
#5
29.05.2017 14:48:28
если вам не трудно на примере можете показать, потом под себя подгоню, можно с открытого файла выгрузку сделать
Изменено: krom - 29.05.2017 14:49:36
 
 
 
#6
29.05.2017 15:03:08
yozhik,
Код
Sub zhas()
Dim i As Long, f As Long, s As String, n As Long, sh As Worksheet, skm As Workbooks
Set skm = Workbooks("plan.xlsm")
Set sh = Worksheets("ТРУ")
    For i = 2 To 7
        For f = 2 To 5
        n = sh.Rows(1).Find(what:=Cells(1, f).Value).Column
            Cells(i, f) = Application.VLookup(Cells(i, 1).Value, skm.sh.Range("A:G"), n, False)
        Next f
    Next i
 MsgBox "Конец!", vbInformation, "Конец"
End Sub

Что не так с кодом, подскажите плиз
Изменено: krom - 29.05.2017 15:51:55
 
 
 
#7
29.05.2017 15:43:50
подставьте свои данные. Макрос запустите с листа, куда надо подставить
Код
Function IsBookOpen(wbFullName As String) As Boolean
    Dim iFF As Integer
    iFF = FreeFile
    On Error Resume Next
    Open wbFullName For Random Access Read Write Lock Read Write As #iFF
    Close #iFF
    IsBookOpen = Err
End Function
Sub zhas()
Application.ScreenUpdating = False
Dim i As Long, f As Long, n As Long, wb As Workbook, awb As Workbook
sh = ActiveSheet.Name ' лист, куда подставляем данные
Set wb = ActiveWorkbook
ash = "Data" 'имя листа, откуда надо взять данные в исходном файле
If IsBookOpen("C:\files\ИФ.xlsx") = True Then check = 1 Else check = 0
Set awb = GetObject("C:\files\ИФ.xlsx") 'полное имя файла
For i = 2 To 7
    For f = 2 To 5
        n = awb.Worksheets(ash).Rows(1).Find(what:=wb.Worksheets(sh).Cells(1, f).Value).Column
        wb.Worksheets(sh).Cells(i, f) = Application.VLookup(wb.Worksheets(sh).Cells(i, 1).Value, awb.Worksheets(ash).Range("A:E"), n, False)
    Next f
Next i
If check = 0 Then awb.Close 0
Application.ScreenUpdating = True
MsgBox "Конец!", vbInformation, "Конец"
End Sub
 
 
 
#8
29.05.2017 15:51:09
krom, Вы видите, как выглядит код у других? Вот и Вы так оформляйте свои коды - ищите такую кнопку и исправьте свои сообщения.
 
 
 
#9
29.05.2017 16:09:10
yozhik, все сделал но нижеследующая линия не пропускает  :(

n = awb.Worksheets(ash).Rows(1).Find(what:=wb.Worksheets(sh).Cells(1, f).Value).Column
Код
Function IsBookOpen(wbFullName As String) As Boolean    Dim iFF As Integer
    iFF = FreeFile
    On Error Resume Next
    Open wbFullName For Random Access Read Write Lock Read Write As #iFF
    Close #iFF
    IsBookOpen = Err
End Function
Sub zhas()
Application.ScreenUpdating = False
Dim i As Long, f As Long, n As Long, wb As Workbook, awb As Workbook
sh = ActiveSheet.Name = "Лист1" ''лист, куда подставляем данные
Set wb = ActiveWorkbook
ash = "Книга2" 'имя листа, откуда надо взять данные в исходном файле
If IsBookOpen("C:\Users\Zh.Zholamanov\Desktop\zhastalap\RD report\zhastalap.xls") = True Then check = 1 Else check = 0
Set awb = GetObject("C:\Users\Zh.Zholamanov\Desktop\zhastalap\RD report\zhastalap.xls") ''полное имя файла
For i = 2 To 7
    For f = 2 To 5
       n = awb.Worksheets(ash).Rows(1).Find(what:=wb.Worksheets(sh).Cells(1, f).Value).Column
        wb.Worksheets(sh).Cells(i, f) = Application.VLookup(wb.Worksheets(sh).Cells(i, 1).Value, awb.Worksheets(ash).Range("A:E"), n, False)
    Next f
Next i
If check = 0 Then awb.Close 0
Application.ScreenUpdating = True
MsgBox "Конец!", vbInformation, "Конец"
End Sub
 
 
 
#10
29.05.2017 16:19:25
проверьте, что в книге zhastalap.xls есть лист с названием "Книга2"
sh = ActiveSheet.Name = "Лист1" - здесь не надо ничего дописывать, просто оставить sh = ActiveSheet.Name
Cells(1, f).Value) - проверьте, что на листе "Лист1" у Вас в первой строке со второго по пятый столбец то, что Вы хотите искать (фио и проч) - проверьте что в исходном файле на листе "Книга2" в первой строке есть эти названия
 
 
 
#11
29.05.2017 16:21:08
krom, и в стартовом сообщении исправьте.
Кросс - создаёте темы на нескольких форумах - информируйте об этом.    
 
 
 
#12
29.05.2017 16:23:53
yozhik, заработал спасибо огромное выручили

Юрий М, кого информировать надо?
 
 
 
#13
29.05.2017 19:00:27
Нас - форумчан.
 
 
 
#14
30.05.2017 07:32:06
Еще кросс:
http://www.excelworld.ru/forum/10-33929-1
Я сам - дурнее всякого примера! ...
 
 
 
Страницы: 1
Наверх