查找和複製代碼

Question

對的人，我回來了一些更多的幫助。我有一本工作手冊，每個月都會添加新的工作表，其結構信息與以前完全一樣。在A欄中，我有發票號碼，然後列B：J的詳細信息。在K & L列中，爲所有未解決的問題手動添加了評論。我想要做的是能夠在最後一張工作表中查找發票，然後將註釋K & L複製到新工作表中。

我試圖創建一些代碼，但沒有什麼是脫落的。 ActiveSheet是沒有評論的新創建的。因此，我想在A列中查找發票編號，並複製列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 

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 

Answer 2

我的建議是，你的VBA代碼放在VLOOKUP公式在新的工作表來獲取這樣的發票信息：

​​3210

then in orde R鍵來替換文本公式你的代碼可以使用後跟

activesheet.Cells(cel.Row, 11).PasteSpecial xlPasteValues

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

只用文字來代替公式值

試試我的代碼

' 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是否正確的列和樂牛逼我們知道你在

菲利普