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

时间:2018-01-28 14:14:12

标签: excel vba loops object copy-paste

我对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

提前致谢!

2 个答案:

答案 0 :(得分:0)

欢迎使用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)

更多信息:

答案 1 :(得分:0)

嗨欢迎堆栈溢出, 我担心你的问题有点难以理解(或者也许只是我)。希望我在正确的轨道上,但我想你想

  1. 选择要查找的值列表
  2. 选择包含这些值的范围以及要返回的列中的其他数据
  3. 将查找的数据列添加到参考列表
  4. 您可以将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