Question

我有两本工作簿。其中一个wb1在A列中包含client个名称，在B列中包含idnumber。另一个工作簿wb2在columb中也有相同的client个名称A（但顺序不同）。我需要做的是从idnumbers复制wb1并使用client名称作为参考粘贴到第二个工作簿。复制的值必须转到用户指定的列（即J，AC，DC）（使用输入框），并且仅当目标单元格尚未填充idnumber时，宏才应粘贴值。

我不确定如何使用application.vlookup方法，如果它是正确的方法或有更简单的方法。

我想听听您的意见

到目前为止，我设法想出了这个

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

Answer 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

Answer 2

感谢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

VBA - 我需要VLookUP-ish代码来复制值

2 个答案: