搜索代码Excel Vba中的增量行

Question

我被困在我的 vba 不会增加行号的问题上。我的表看起来像： 工作表1

name value  
aa  11  
bb  12  
cc  13  
aa  14  
cc  15  
cc  16  
aa  17  
bb  18  
aa  19  

表 2

name
aa
bb
cc

我需要搜索每个特定值，如果找到将相邻单元格复制到 sheet2 就在下一个搜索值。这是代码，但问题在于行增量，所有搜索的值都在一行中（变量 k 不起作用）。

Sub finall()
Dim cable As String
Dim finalrow1 As Integer
Dim finalrow2 As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
l = 2
k = 2
finalrow2 = Sheets("Sheet2").Range("A1000").End(xlUp).Row
finalrow1 = Sheets("Sheet1").Range("A1000").End(xlUp).Row
For j = 2 To finalrow2
    cable = Sheets("Sheet2").Cells(j, 1).Value
    For i = 2 To finalrow1
        If Cells(i, 1) = cable Then
            Sheets("Sheet1").Cells(i, 2).Copy
            Sheets("Sheet2").Cells(k, l).End(xlUp).Offset(1, 0).PasteSpecial
            l = l + 1
        End If
    Next i
    k = k + 1
Next j
End Sub

这只是最终的示例，我想将此代码应用于具有 50-60k 行的表。

最终表格应如下所示：

name                
aa  11  14  17  19
bb  12  18      
cc  13  15  16  

谢谢

Answer 1

最终代码如下

Sub finall()
    Dim cable As String
    Dim finalrow1 As Long
    Dim finalrow2 As Long
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim l As Long
    l = 2
    k = 2
    finalrow2 = Sheets("Sheet2").Range("A1000").End(xlUp).Row
    finalrow1 = Sheets("Sheet1").Range("A1000").End(xlUp).Row
    Worksheets("Sheet2").Select
    For j = 2 To finalrow2
        cable = Sheets("Sheet2").Cells(j, 1).Value
        For i = 2 To finalrow1
            If Sheets("Sheet1").Cells(i, 1) = cable Then
                Sheets("Sheet1").Cells(i, 2).Copy
                Sheets("Sheet2").Cells(k, l).PasteSpecial
                l = l + 1
            End If
        Next i
        k = k + 1
        l = 2
    Next j
End Sub

工作证明