Question

合适的人，我又回来寻求更多的帮助。我有一个工作簿，我每个月都会添加新的工作表，其中的信息与之前的结构完全相同。在A栏中，我有发票编号，然后是B：J栏中的详细信息。在K＆amp;列中L手动添加了针对所有未解决问题的注释。我想要做的是能够针对上一个工作表查找发票，然后在K＆amp;列中复制注释。 L进入新的工作表。

我试图创建一些代码，但没有任何东西可以实现。 ActiveSheet是新创建的没有注释。所以我想在A列中查找发票号码并复制列K＆amp; L从最后一个工作表到活动表的列K＆amp; 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

Answer 1

您在上一页的with语句中，并且不存在activesheet语句。使用：

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

，您不应该需要On Error Resume Next，因为返回的范围为nothing，并确保在完成每次查找后set 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

我的代码：

{{1}}

Answer 2

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

activesheet.Cells(cel.Row, 11).formula="=VLOOKUP(...)"

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

activesheet.Cells(cel.Row, 11).Copy

接着是

activesheet.Cells(cel.Row, 11).PasteSpecial xlPasteValues只用文本值替换公式

试试我的代码

 ' 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是否在正确的列上行动，让我们知道你是如何开始的

菲利普

查找并复制代码

2 个答案: