循环宏以复制用户输入范围并粘贴到未知打开工作簿中的用户输入范围

Question

我对 VBA 很陌生。几个星期以来，我一直在尝试开发一个模仿 Excel 中的 vlookup 和 hlookup 函数的代码。

我正在构建一个宏，用于将数据从一个工作簿复制并粘贴到另一个工作簿中。

数据将在源工作簿和目标工作簿的左侧列中具有参考值。

目标工作簿中的参考值与源工作簿中的参考值的顺序不同。

要复制的数据将位于距离参考值 4 列的位置。数据（连同参考值）可以是数千行和数百列的长度。

目标工作簿和源数据所在的工作簿都将打开。

用户将在源工作簿和目标工作簿中指定引用值的位置。

用户还将指定要复制的数据范围

所有数据都将被复制。

这是我一直在处理的示例文件。我的实际数据会远远大于这个。数据从这里复制过来：Original Workbook

然后将数据粘贴到此工作簿中。目标工作簿看起来很相似，但您可以看到参考数据的顺序不同：Destination Workbook

此外，在同一张工作表中成功循环后（粘贴范围是同一工作簿中的同一张工作表），我收到此错误： 我还收到“运行时错误 91。对象变量或未设置块变量。” 这是我到目前为止得到的：

> Sub copyv5input()
>  
> Dim wsSrc As Worksheet Dim wbSrc As Workbook Dim wsTgt As Worksheet
> Dim wbTgt As Workbook Dim vRng1 As Range Dim vNo As Range Dim rNum As
> Integer Dim vRef1 As Range Dim vRng2 As Range Dim vDest1 As Variant
> Dim vDest2 As Variant Dim vDest3 As Range Dim cNum As Integer Dim
> cNum2 As String Dim vNew2 As Range
> 
> rNum = 1 
> cNum = 1 
>     Set vRng1 = Application.InputBox("Select the range of reference data:", Type:=8)    '1
>     Set vRef1 = vRng1.Cells(rNum, cNum)     '1
>     
>     
>     
>     Set vRng2 = Application.InputBox("Select the reference data range for destination:", Type:=8)   '2
>      
>         
>    
>     Set vDest1 = vRng2.Find(what:=vRef1)    '2
>     Set vDest2 = Range(vDest1.Address)      '2
>     Set vDest3 = vDest2.Offset(0, 1).Resize(, 4)    '2
> 
> Do While vRef1 <> ""
> 
> Set vNo = vRef1.Offset(0, 4).Resize(, 4)    '1
>          
>          If vRef1 = vDest1 Then
>         
>             vNo.copy Destination:=vDest3
>         
>         
>          End If
>     
>     rNum = rNum + 1
>         
>             Set vRef1 = vRng1.Cells(rNum, cNum)
>             Set vDest1 = vRng2.Find(what:=vRef1)
>             Set vDest2 = Range(vDest1.Address)      '2
>             Set vDest3 = vDest2.Offset(0, 1).Resize(, 4)
>      Loop
>        
> 
> End Sub

提前致谢！

Answer 1

您好，欢迎来到堆栈溢出， 恐怕你的问题有点难以理解（或者可能只是我）。希望我在正确的轨道上，但我认为你想要

1. 选择要查找的值列表
2. 选择一个范围，其中包含您要返回的这些值和列中的其他数据
3. 将查找到的数据列添加到参考列表中

您可以将 Application.WorksheetFunction 属性用于 vlookup，或者我会做的方式是遍历每个值以查找匹配项，然后在同一行但在另一列上返回该值。对于长数据列表，这可能会有点慢，但它很简单并且可以工作

 Sub copyv5input2()


 Dim vRng1 As Range

 Dim rNum As Integer
 Dim rNum2 As Integer
 Dim vRef1 As Range
 Dim vRng2 As Range
 Dim cNum As Integer
 Dim lookupV As String
 Dim foundR As Long
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set vRng1 = Application.InputBox("Select the range of reference data:", Type:=8)
Set vRng2 = Application.InputBox("Select the reference data range for destination:", Type:=8)   '2
cNum = Application.InputBox("Select the column number you want to return from reference data:")


For rNum = 1 To vRng1.Rows.Count

    lookupV = vRng1.Cells(rNum, 1).Value
    For rNum2 = 1 To vRng2.Rows.Count
        If vRng2.Cells(rNum2, 1) = lookupV Then
            vRng1.Cells(rNum, 1).Offset(0, 1) = vRng2.Cells(rNum2, cNum).Value
            foundR = foundR + 1
            GoTo 10
        End If
    Next rNum2
10
Next rNum

With Application
    .ScreenUpdating = true
    .Calculation = xlCalculationAutomatic

End With
MsgBox "complete, " & foundR & " values returned", vbInformation, "auto lookup"

 End Sub

Answer 2

欢迎来到 Stack Overflow！

您可以通过 VBA 函数使用 Excel 工作表函数：Application.Worksheet。

例如，我有一个工作表函数：

=VLOOKUP(D7,$A$2:$B$5,2,FALSE)

...所以在 VBA 中，我可以使用以下命令弹出一个具有相同结果的 MsgBox 对话框：

MsgBox Application.WorksheetFunction.VLookup(Range("D7"), Range("$A$2:$B$5"), 2, False)

更多信息：

• Application.WorksheetFunction Property 的 MS 文档

• WorksheetFunction Object 的 MS 文档

• Calling Worksheet Functions From VBA by Chip Pearson _{（Excel 之王！）}