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

Loop macro to copy user input range and paste to user input range in unknown open workbook

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

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

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

目标工作簿中的引用值与源工作簿中的引用值的顺序不同。

要复制的数据将位于距参考值 4 列的位置。数据(连同参考值)可以是数千行和数百列。

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

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

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

将复制所有数据。

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

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

此外,在同一 sheet 中成功循环后(粘贴范围与同一工作簿中的 sheet 相同)我收到此错误: 我还收到“运行时错误 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

提前致谢!

欢迎来到 Stack Overflow!

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

比如我有一个工作表函数:

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

...所以在 VBA 中,我可以使用以下方法弹出一个具有相同结果的 MsgBox 对话框:

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

更多信息:

您好,欢迎来到 stack overflow, 恐怕您的问题有点难以理解(或者可能只有我一个人)。希望我在正确的轨道上,但我认为你想要

  1. select 您要查找的值列表
  2. select 包含这些值的范围以及您想要 return
  3. 的列中的其他数据
  4. 将查找到的数据列添加到引用列表

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

 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