Excel 查找并复制代码

对了，各位，我再次回来寻求更多的帮助。我有一个工作簿，每个月我都会添加新的工作表，其中的信息在结构上与以前完全相同。在A列中，我有发票编号，然后是B:J列中的详细信息。在K和L列中，有针对所有未决问题手动添加的注释。我想做的是能够根据上一张工作表查找发票，然后将K和L列中的注释复制到新工作表中

我尝试过创建一些代码，但是没有任何结果。ActiveSheet是新创建的，没有注释。所以我想查找A列中的发票号，并将K&L列复制到activesheet的K&L列，在K&L列中找到匹配项。我希望我有道理，谢谢你的帮助

Option Explicit

Sub FindCopy_all()

    Dim calc As Long
    Dim Cel As Range
    Dim LastRow As Long
    Dim rFound As Range
    Dim LookRange As Range
    Dim CelValue As Variant

     ' Speed
    calc = Application.Calculation
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

     'Get Last row of data ActiveSheet, Col A
    LastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row

     ' Set range to look in
    Set LookRange = ActiveSheet.Range("A1:A" & LastRow)

     ' Loop on each value (cell)
    For Each Cel In LookRange
         ' Get value to find
        CelValue = Cel.Value
         ' Look on previous sheet
        With Sheets(Sheets.Count - 3)

            Set rFound = .Cells.Find(What:=CelValue, _
            After:=.Cells(1, 1), LookIn:=xlValues, _
            Lookat:=xlWhole, MatchCase:=False)

             ' Reset
            On Error GoTo endo

             ' Not found, go next
            If rFound Is Nothing Then
                GoTo NextCel
            Else
                 ' Found. last sheet, Col K & L to Active Sheet found Row, Col K & L
                .Cells(rFound.Row, 11, 12).Resize(, 2).Copy ActiveSheet.Cells(Cel.Row, 11, 12)
            End If
        End With
NextCel:
    Next Cel
Set rFound = Nothing

     'Reset

endo:

    With Application
        .Calculation = calc
        .ScreenUpdating = True
    End With

End Sub

---

您在上一页的

with

语句中，并且不存在

activesheet

语句。使用：

.Cells(rFound.Row, 11).Resize(,2).Copy activesheet.Cells(cel.Row, 11)

同样，您不需要在错误恢复下一步时执行

，因为返回的范围将是
无
，并且确保在完成每个查找后
设置rFound=nothing

NextCel:
set rFound = nothing


我的代码：

Option Explicit

Sub FindCopy_all()

    Dim calc As Long
    Dim Cel As Range
    Dim LastRow As Long
    Dim rFound As Range
    Dim LookRange As Range
    Dim CelValue As Variant

     ' Speed
    calc = Application.Calculation
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

     'Get Last row of data ActiveSheet, Col A
    LastRow = ActiveSheet.Cells(1048576, 1).End(xlUp).Row

     ' Set range to look in
    Set LookRange = ActiveSheet.Range("A1:A" & LastRow)

     ' Loop on each value (cell)
    For Each Cel In LookRange
         ' Get value to find
        CelValue = Cel.Value
         ' Look on previous sheet
        With Sheets(Sheets.Count - 1)

            Set rFound = .Range("A:A").Find(What:=CelValue, _
            After:=.Cells(1, 1), LookIn:=xlValues, _
            Lookat:=xlWhole, MatchCase:=False)

             ' Not found, go next
            If rFound Is Nothing Then
                GoTo NextCel
            Else
                 ' Found. last sheet, Col K & L to Active Sheet found Row, Col K & L
                .Cells(rFound.Row, 11).Resize(, 2).Copy ActiveSheet.Cells(Cel.Row, 11)
            End If
        End With
NextCel:
    Set rFound = Nothing
    Next Cel

    With Application
        .Calculation = calc
        .ScreenUpdating = True
    End With

End Sub

我的建议是，VBA代码将VLOOKUP公式放入新工作表中，以检索发票信息，如下所示：

activesheet.Cells（cel.Row，11）.formula=“=VLOOKUP（…）”

然后，为了用文本替换公式，您的代码可以使用

activesheet.Cells（cel.Row，11）。复制

接

activesheet.Cells（cel.Row，11）.pasteValues
仅用文本值替换公式

试试我的代码

 ' Speed
calc = Application.Calculation
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

 'Get Last row of data ActiveSheet, Col A
LastRow = ActiveSheet.Cells(activesheet.rows.count, 1).End(xlUp).Row

 ' Set VLOOKUP formula, search on the other sheet for the value in column A, return the value matchiung from column 11, and use EXACT MATCH.
'
' =VLOOKUP(A:A,Sheet1!A:L,11,FALSE) ' example
'
range("K1:K" & lastRow).formula="=VLOOKUP(A:A," & sheets(Worksheets.count-1).name & "!A:L,11, FALSE)"

activesheet.calculate
range("K1:K" & lastRow).copy
range("K1:K" & lastRow).pastespecial xlpastevalues ' remove the formulas

这应该让你开始，试着通过这一步，检查VLOOKUP是否在正确的列上运行，并让我们知道你进展如何

菲利普你好，谢谢你的回答。从上一张图纸复制到活动图纸时没有任何内容。绝对没有。此外，我想复制注释和操作所在的K&L列。非常感谢您的帮助，代码正在工作，但它与粘贴到正确行的内容不匹配。是否需要进行调整以实现此目标？您好，请有人帮忙。我的代码正在工作，但与它从旧工作表中提取的内容不匹配。我的意思是，当在新工作表中找到发票时，属于该发票的注释（如果它在前一工作表中）与它不匹配，就像完成vlookup时一样。为了进行测试，我从上一张表中获取了完全相同的数据，但不包括K和L列。但是当我运行宏时，注释未与发票匹配。我只会搜索发票列，并确保数据在ad之前或之后没有空格。您正在使用xlwholeis。您为什么不能在最后一张工作表的目标列中使用VLOOKUP公式来获取与您所需匹配的注释数据？唯一的原因是我想这样做自动化流程，而不是花时间做公式。我在一家小公司工作，有计算机文盲助手，最简单的方法是使用VBA代码，只需点击一个按钮即可完成所有工作。好的，但为什么不在添加新工作表时自动输入公式，例如
Range（“…”）。公式=“=VLOOKUP（…）”
所以工作将通过工作表中的公式完成，我不想告诉他该怎么做；）但这是个好主意，比老年退休金计划的表现更好。