Question

我试图从大量工作表中复制行。我有多行与某个文档相关，具体取决于版本。因此，某些行具有相同的引用，相同的名称但创建的版本/日期不同。我想复制到另一张纸（例如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

Answer 1

除非你需要格式化，否则我认为应该避免复制和粘贴。

以下代码假设数据在A列上排序。如果不需要另一个方法。

编辑：改编为可能有空白行的评论。

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

根据多个单元格值

1 个答案: