搜索代码Excel Vba中的增量行

debugcn 发表于 Dev

埃扎洛尔

我陷入了我的vba不会增加行号的问题。我的表格如下：Sheet1

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

谢谢

卡西克·古纳塞卡兰（Karthick Gunasekaran）

最终代码如下

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

工作证明