2016-10-04 11 views
0

У меня есть две книги. Один из них wb1 состоит из client имен в столбце A и idnumber в столбце B. В другой книге wb2 также есть те же имена client в columb A (но в другом порядке). Что мне нужно сделать, так это скопировать idnumbers с wb1 и вставить во вторую книгу, используя имя client в качестве ссылки. Скопированные значения должны перейти к столбцу (например, J, AC, DC), заданному пользователем (используя поле ввода), и макрос должен вставлять значения только в том случае, если целевая ячейка еще не заполнена idnumber.VBA - Мне нужен код VLookUP-ish для копирования значений

Я не уверен, как использовать метод application.vlookup, и если это правильный путь или существуют более простые методы.

Id хотел бы услышать ваши советы

До сих пор я сумел придумал этот

Sub copy_val() 
Dim lookfor As Range, lookin As Range, found As Variant, col as variant 


Set lookfor = Workbooks("wb1.xlsm").Sheets("Sheet1").Range("A2:a22") 
Set lookin = Workbooks("wb2.xlsm").Sheets("Sheet2").Range("A2:a22") 

col = InputBox("please provide input colum") 
found = apllication.VLookup(lookfor.Value, lookin, col, 0) 


For Each cl In ActiveSheet.Range("B2:b21") 
Range("B&Activecell.row").Select 
Selection.Copy 
Range("found").Select 
Selection.Paste 


End Sub 

Я также использовал этот один, но я не знаю, почему я не могу получить надлежащий адрес ячейки с помощью:

col = inputbox("please provide input column" 
id_row = sheets.("sheet2).range("col"&"2").row 
id_col = sheets.("sheet2).range("col"&"2").column 
+3

Начните с размещения кода, который у вас есть. – Miqi180

+0

(см. [Как спросить] (http://stackoverflow.com/help/how-to-ask), если вам интересно, почему вы, возможно, получили downvotes.) – BruceWayne

+0

@ Miqi180 я отредактировал сообщение, чтобы показать вам мой код – mm90

ответ

1

Вот код, который вы ищете.

Sub VLookupUDF() 

Dim wb As Workbook 
Dim ws, ws1 As Worksheet 
Dim rng As Range 
Dim col As String 

Set wb = ActiveWorkbook 
Set ws = ActiveWorkbook.Sheets(<source sheet name>) 
Set ws1 = ActiveWorkbook.Sheets(<sheet name for vlookup>) 
wb.Activate 

Set rng = ws.Range("A:B") 
ws1.Select 

col = InputBox("please provide input colum") 

For Each cl In ws1.Range("B2:b21") 

If ws1.Cells(cl.Row, CStr(col)).Value = "" Then 
ws1.Cells(cl.Row, col).Formula = "=VLOOKUP(" & cl.Address & "," & rng.Worksheet.Name & "!" & rng.Address & ",2,0)" 
ws1.Cells(cl.Row, col).copy 
ws1.Cells(cl.Row, col).pastespecial xlpastevalues 

End If 

Next cl 
End Sub 
+0

Thats хороший код, над которым я могу работать. Эта штука: 'Ячейки (cl.Row, col) .Formula =" = VLOOKUP ("& cl.Address &", "& rng.Worksheet.Name &"! "& Rng.Address &", 2,0) «буквально добавляет формулу в эту ячейку, но мне нужна фактическая величина вместо формулы внутри ячейки. Также предоставленный вами код ищет значение в целевом листе вместо исходного листа (вот почему я получаю« N »/A "в ячейке). Но я думаю, я могу изменить его сам с некоторыми настройками, чтобы соответствовать моему делу. – mm90

+0

Вставьте имена листов вместо индекса при установке ws & ws1. копирование и вставка ячейки в качестве значения в том же месте поможет вам получить значение вместо формулы. Проверьте обновленную версию ответа. –

+1

все эти ссылки «Ячейки» нуждаются в объекте листа перед ними – Brad

1

Благодаря Aditya Pansare и некоторые хитрости, чтобы соответствовать моему случаю, я нашли полное решение.

Sub VLookupUDF() 

Dim wb1, wb2 As Workbook 
Dim ws1, ws2 As Worksheet 
Dim rng As Range 
Dim col As String 

Set wb1 = Workbooks("wb1.xlsm") 
Set wb2 = Workbooks("wb2.xlsm") 
Set ws1 = wb1.Sheets("Data table") 
Set ws2 = wb2.Sheets("Reg input") 



wb1.Activate 
Set rng = ws1.Range("A:B") 
wb2.Activate 
ws2.Select 

col = InputBox("Please provide input column") 

For Each cl In ws1.Range("A2:A21") 

If ws2.Cells(cl.Row, CStr(col)).Value = "" Then 
ws2.Cells(cl.Row, col).Formula = "=VLOOKUP(" & cl.Address & ",'[wb1.xlsm]Data table'!$A:$B,2,0)" 
ws2.Cells(cl.Row, col).Copy 
    With ws2.Cells(cl.Row, col) 
     .PasteSpecial xlPasteValues 
     .NumberFormat = "hh:mm" 
    End With 


End If 

Next cl 
MsgBox ("Export completed") 
End Sub 
Смежные вопросы