首页 > 解决方案 > 我无法正确定义 finalrow

问题描述

我试图制作一个将包含特定值的行复制到另一个工作表的 VBA。我在 youtube ( https://www.youtube.com/watch?v=-QFjJoRGCtU&t=332s )上遇到了这个人,并遵循了他的公式。当我尝试运行它时,它只会将第一行复制并粘贴到另一个工作表中。我猜我没有finalrow正确定义这就是它失败的原因。愿意为我修复我的代码吗?

这是我的代码:

Sub Search_Extract()
    Dim resultnumber As Integer
    Dim finalrow As Long
    Dim datasheet As Worksheet, reportsheet As Worksheet
    Dim i As Integer 'rowcounter

    Set datasheet = Sheet4
    Set reportsheet = Sheet3
    resultnumber = reportsheet.Range("A1").Value

    reportsheet.Range("D5:F7000").ClearContents

    datasheet.Select
    finalrow = Cells(Rows.Count, 3).End(xlUp).Row

    For i = 1 To finalrow
        If Cells(i, 3) = resultnumber Then
            Range(Cells(i, 1), Cells(i, 3)).Copy
            reportsheet.Select
            Range("D6700").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        End If
    Next i

    reportsheet.Select
End Sub

标签: excelvba

解决方案


VBA 查找

  • 我保持它接近最初的想法。它可以在多个帐户上进行改进,例如通过使用数组AutoFilter、、、AdvancedFilter等等。
  • 随意将变量重命名回它们的初始名称。唯一的新变量是dRow跟踪当前目标行,因此您不需要“...(xlup).Offset(1)业务”。注意dRow = dRow + 1.
  • 大多数时候你不想使用Selector Activate。改为限定您的范围,即注意sws.dws.前面的RangeCellsRows每个范围“属于”工作表)。这应该是你从这段代码中学到的最重要的一课。

快速修复

Option Explicit

Sub SearchExtract()
    
    ' Source (DataSheet) - being read from
    Dim sws As Worksheet ' Worksheet
    Dim sRow As Long ' Current Row
    Dim slRow As Long ' Last row
    
    ' Destination (ReportSheet) - being written to
    Dim dws As Worksheet ' Worksheet
    Dim dRow As Long ' Current Row
    
    ' Other
    Dim SearchNumber As Long ' Criteria
    
    ' Source
    Set sws = Sheet4
    slRow = sws.Cells(sws.Rows.Count, "C").End(xlUp).Row
    
    ' Destination
    Set dws = Sheet3
    dws.Range("D5:F" & dws.Rows.Count).ClearContents
    dRow = 5
    SearchNumber = dws.Range("A1").Value
    
    ' Loop & Copy Values
    For sRow = 1 To slRow ' use 2 if you have headers in the first row
        If sws.Cells(sRow, "C").Value = SearchNumber Then
            dws.Range(dws.Cells(dRow, "D"), dws.Cells(dRow, "F")).Value _
                = sws.Range(sws.Cells(sRow, "A"), sws.Cells(sRow, "C")).Value
            dRow = dRow + 1
        End If
    Next sRow

End Sub

推荐阅读