Импорт данных с помощью HLOOKUP на VBA - PullRequest
Новая
       19

Импорт данных с помощью HLOOKUP на VBA

0 голосов
/ 08 октября 2018

Я пытаюсь записать некоторые данные из одного листа в другой, используя VBA, но я застрял с кодом.По сути, в Sheet1 у меня есть следующие столбцы для дополнения данными из Sheet2: 

       A    B   C        D      E        F
1   Month   ID  Country  Name   Surname  Email
2   
3
4

, а в Sheet2 у меня есть входные данные: 

       A     B     C        D          E         F    G
1   Month    ID    Address  Telephone  Surname   Name Email
2   04-2018  2131  ***      ***        ***       ***  ***
3   04-2018  2133  ***      ***        ***       ***  ***
4   04-2018  2411  ***      ***        ***       ***  ***

В Excel я бы использовалследующая функция, расположенная в ячейке A2:

=HLOOKUP(A$1,Sheet2!$A$1:$G$5,ROW(), FALSE)

, которая работает хорошо.Однако в VBA следующая функция сообщает об ошибке: 

Function hlookup()

Range("A2").Value = Application.hlookup(Range("A1"), Sheet2.Range("a1").End(xlDown).Select, 2, False)

End Function

Ошибка времени выполнения '1004':

Невозможно получить свойство Select класса Range.

Я знаю, что проблема находится в пределах досягаемости, но я не могу найти способ заставить это работать.

Я очень новичок в VBA и постарался сделать его простым и понятным, поэтому любые предложения по улучшению кода будут хорошо приняты.

1 Ответ

0 голосов
/ 08 октября 2018

Вам не нужно искать каждую строку, если вы просто хотите изменить порядок столбцов. 

Option Explicit

Public Sub CopyData()
    Dim wsDest As Worksheet
    Set wsDest = ThisWorkbook.Worksheets("Sheet1")

    Dim wsSrc As Worksheet
    Set wsSrc = ThisWorkbook.Worksheets("Sheet2")

    Dim LastRow As Long
    LastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row

    Dim DestHeader As Range
    Set DestHeader = wsDest.Range(wsDest.Range("A1"), wsDest.Cells(1, wsDest.Columns.Count).End(xlToLeft))

    Dim SrcHeader As Range
    Set SrcHeader = wsSrc.Range(wsSrc.Range("A1"), wsSrc.Cells(1, wsSrc.Columns.Count).End(xlToLeft))

    Dim FoundCell As Range
    Dim Cell As Range
    For Each Cell In DestHeader
        Set FoundCell = Nothing
        On Error Resume Next
        Set FoundCell = SrcHeader.Find(What:=Cell.Value, LookAt:=xlWhole)
        On Error GoTo 0

        If Not FoundCell Is Nothing Then
            Cell.Offset(1).Resize(LastRow - 1).Value = FoundCell.Offset(1).Resize(LastRow - 1).Value
        End If

    Next Cell
End Sub
...