如何将行VBA Excel的特定部分复制到另一个工作表?

时间:2017-11-21 17:26:09

标签: excel vba excel-vba

我自己解决了。我添加了一个for循环。这是我的工作代码。感谢所有其他人试图提供帮助。

Sub runMatch()

Dim critRemID, listRemID, critRemIDstart, listRemIDstart As Range

Set critRemID = Worksheets("Enterprise - score").Cells(2, 1)
Set listRemID = Worksheets("Sheet1").Cells(2, 1)
Set critRemIDstart = Worksheets("Enterprise - score").Cells(2, 30)
Set listRemIDstart = Worksheets("Sheet1").Cells(2, 2)

Dim i, j, index As Integer
i = 0
j = 0

    Do While critRemID.Offset(i, 0) <> ""
    If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
    For index = 0 To 84
    critRemIDstart.Offset(i, index) = listRemIDstart.Offset(j, index).Value
    Next index
    i = i + 1
    j = 0
    index = 0
    Else
    If listRemID.Offset(j, 0) = "" Then
    j = 0
    i = i + 1
    Else
    j = j + 1
    End If
    End If

    Loop


End Sub
  

我有两张纸,每张纸都有相同的ID但是   不同的数据集。

     

我想扫描数据行,如果匹配,请复制   整行从某一列到另一列的某一列   其中一张纸的末尾。

     

第1页是我要复制信息的表格,最后我已经创建了   我希望从表2中带来的数据的标题相同。

     

下面的代码就是我所拥有的,我为ID设置了一个范围   我希望复制的单元格在哪里开始

Dim critRemID, listRemID, critRemIDstart, listRemIDstart As Range

Set critRemID = Worksheets("Enterprise - score").Cells(2, 1)
Set listRemID = Worksheets("Sheet1").Cells(2, 1)
Set critRemIDstart = Worksheets("Enterprise - score").Cells(2, 30)
Set listRemIDstart = Worksheets("Sheet1").Cells(2, 90)

Dim i, j As Integer
i = 0
j = 0


Do While critRemID.Offset(i, 0) <> ""
If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
critRemIDstart.Row(i) = listRemIDstart.Row(j).Value
i = i + 1
j = 0
Else
j = j + 1
End If

Loop
     

我一直收到此错误

     
    

参数数量错误或属性分配无效

  
     

我尝试了一条不同的路线,但如图所示一直感到困惑   下面。我试图让它逐个复制每个单元格   到达一个空单元格,它将移动到主要的下一个ID   表并重新开始,但这没有任何作用,我认为它保持不变   增加工作表上的两个ID,永远不会找到匹配项。

If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
critRemIDstart.Offset(i, k) = listRemIDstart.Offset(j, l).Value
k = k + 1
l = l + 1
Else
If listRemIDstart.Offset(j, l) = "" Then
    j = j + 1
    l = 0
    i = i + 1
    k = 0
Else
j = j + 1
i = i + 1
l = 0
k = 0
End If
End if
     

任何帮助表示赞赏。感谢。

3 个答案:

答案 0 :(得分:1)

Range.Find方法可以轻松找到密钥。

Dim critRem, listRem As Worksheet
Set critRem = Worksheets("Enterprise - score")
Set listRem = Worksheets("Sheet1")

Dim critRemID, listRemID, cell, matchedCell As Range

With critRem
    Set critRemID = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
With listRem
    Set listRemID = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each cell In critRemID
    Set matchedCell = listRemID.Find(cell.Value)
    If matchedCell Is Nothing Then 'ID is not found
        'Do nothing
    Else 'ID is found, matchedCell is pointed to column A now
        cell.Offset(0, 29).Resize(1, 10) = matchedCell.Offset(0, 89).Resize(1, 10)
        'offset(0,29) means offsetting right 29 columns
        'resize(0,10) means resizing the range with 1 row and 10 columns width
        'feel free to change the number for your data
    End If
Next cell

注意:如果您对offset().resize()感到困惑,还有另一种方法。 cell.Row为您提供应写入数据的行,matchedCell.Row为您提供ID匹配的行。因此,您可以通过listRem.Range("D" & matchedCell.Row)

之类的内容访问某些单元格

答案 1 :(得分:1)

如果你说两个工作表具有相同的ID,那么为什么不使用Vlookup函数将数据带入Sheet1,然后只需复制结果并粘贴为值,这样就可以去除它们上面的公式?

像循环运行的东西:

For i = 1 to LastRow
Sheet1.cells(i, YourColumnNumber).value = "=VLOOKUP(RC[-1], Sheet2!R1:R1048576, 3, False)"
Next i

答案 2 :(得分:1)

Tried to do it using the loop.

    Sub Anser()

        Dim critRemID           As Range
        Dim listRemID           As Range
        Dim critRemIDstart      As Range
        Dim listRemIDstart      As Range

'::::Change Sheet names and column numbers:::::
        Set critRemID = Worksheets("Sheet1").Cells(2, 1)
        Set listRemID = Worksheets("Sheet2").Cells(2, 1)
        Set critRemIDstart = Worksheets("Sheet1").Cells(2, 2)
        Set listRemIDstart = Worksheets("Sheet2").Cells(2, 2)

        Dim i, j As Integer
        i = 0
        j = 0

        Do
        If critRemID.Offset(i, 0) = listRemID.Offset(j, 0) Then
                critRemIDstart.Offset(i) = listRemIDstart.Offset(j)
                i = i + 1
                j = 0
        Else
                j = j + 1
        End If

        Loop While critRemID.Offset(i, 0) <> ""
    End Sub