基於多個單元格值複製行

我試圖從大量的工作表中複製行。根據不同的版本，我有多個與某個文檔相關的行。因此，一些行具有相同的參考，相同的名稱，但具有不同的版本/創建日期。我想複製到另一個工作表（例如Sheet2）每個文檔的最新版本。基於多個單元格值複製行

我已經嘗試了至少幾個while循環來檢查所有行和如果檢查日期的值，但我沒有使它的工作，我不知道它是否是一種有效的方式做到這一點。這裏是我的問題的圖片和代碼的一部分，我寫道：

Dim Name as String 
Dim Dates as Date 
With Sheets(Sheet1) 
    Application.DisplayAlerts = False 
    Name = Cells(1,3) 'Initialise Name 
    Dates = Cells(1,5) 'Initialise Dates 
    LineCopy = 1 'The line we'll copy 
    Line = 1 'The line we use to check the sheet 
    While Name <> "" 'if the name is not empty, ie there are no documents left 



     While Sheets(Sheet1).StrComp(Name, .Cells(Line, 3)) = True 'WHile you are working with a same name document 
      If .Cells(Line, 5) > Dates Then 'If the document is older, then choose it. 
       Dates = .Cells(Line, 5) 

      Else 
       LineCopy = Line 'If there are no older documents, then it's the one to copy 
       Sheets(Sheet1).Range("A" & LineCopy & ":" & "E" & LineCopy).Copy ' Copy the oldest document 

       Sheets(Sheet2).Paste 
      End If 

      Line = Line + 1 ' Increment the Line in the second while to check every line 

     Wend 
     Name = .Cells(LineCopy + 1, 6) 'After the first while, let's change name to the second document and do it all over again. 

    Wend

來源

2016-06-17 Pierre-Etienne

所以你想複製基於最新日期的行與獨特的參考。我對嗎？ –

根據我的理解，你需要這個函數'= MAX（E2：E4）'它給你最近的日期 –

是的，但是我不知道每個文檔有多少行。 –

除非你需要格式化我想複製，應該避免糊。

下面的代碼假定數據在列A上排序。如果不需要另一個aproach。

編輯：適應評論，可能有空白行。

Dim max_date As Date 
Dim max_row As Long 
Dim old_sheet As Worksheet 
Dim new_sheet As Worksheet 
Dim counter As Long 
Dim last_name as String 

Set new_sheet = Sheets("Sheet2") 'adjust name to result sheet 
counter = 1 


For x = 1 To 5 ' the sheets you should loop thru 
    Set old_sheet = Sheets(x) 
    end_row = old_sheet.Cells(old_sheet.Rows.Count, 1).End(xlUp).Row 

    For i = 2 To end_row 'loop all rows 
     If old_sheet.Cells(i, 5) > max_date Then 'if the date is larger, sve the date and the row 
      max_date = old_sheet.Cells(i, 5) 
      max_row = i 
     End If 

     if old_sheet.cells(i,j)<>"" then last_name = old_sheet.cells(i,j) 

     If (old_sheet.Cells(i + 1, 1) <> "" and old_sheet.Cells(i + 1, 1) <> last_name) or i = end_row Then 
      For j = 1 To 4 
       new_sheet(counter, j) = old_sheet(max_row, j) 'add the data to the new sheet 
      Next j 
      max_date = DateValue("01/01/1970") 'reset the date value 
      counter = counter + 1 'new row to move the data to 
     End If 
    Next i 
Next x

來源

2016-06-17 11:29:47 Fredrik

謝謝。雖然我仍然有問題，但它工作得很好：有時文檔的最後一個版本不在下一個文檔的上方。在我的示例中，第4行可能爲空，所以我需要使用第3行，但是複製是在old_sheet.Cells（i + 1，1）<> old_sheet.Cells（i，1）測試之後進行的，因此在我的案件。我該如何解決它？ –

@ Pierre-EtienneLeyder我編輯了上面的代碼來保存一個臨時字符串。 – Fredrik

作品很有魅力，謝謝！ –

基於多個單元格值複製行

回答

相關問題