Question

您好，我使用此代码将特定条目从一个工作表复制到另一个工作表。假设我要根据第2列中的条目（从最旧到最新日期）对所有数据进行排序。这怎么可能？有任何想法吗？谢谢！

Sub As_Of_Analysis_Sorting()
    Dim lr As Long, lr2 As Long, r As Long
    Set Sh1 = ThisWorkbook.Worksheets("service")
    Set Sh2 = ThisWorkbook.Worksheets("Copy")
    Sh1.Select

    Sh2.Cells(1, 1).Value = "1"
    Sh2.Cells(1, 2).Value = "2"
    Sh2.Cells(1, 3).Value = "3"
    Sh2.Cells(1, 4).Value = "4"
    Sh2.Cells(1, 5).Value = "5"
    Sh2.Cells(1, 6).Value = "6"
    Sh2.Cells(1, 7).Value = "7"
    Sh2.Cells(1, 8).Value = "8"
    Sh2.Cells(1, 9).Value = "9"
    Sh2.Cells(1, 10).Value = "10"
    Sh2.Cells(1, 11).Value = "11"
    Sh2.Cells(1, 12).Value = "12"
    Sh2.Cells(1, 13).Value = "13"
    Sh2.Cells(1, 14).Value = "14"
    Sh2.Cells(1, 15).Value = "15"
    Sh2.Cells(1, 16).Value = "16"


    lr = Sh1.Cells(Rows.Count, "A").End(xlUp).Row
    x = 2
    For r = 2 To lr
        If Range("C" & r).Value = "In Arbeit" Then
            Sh2.Cells(x, 1).Value = Sh1.Cells(r, 1).Value
            Sh2.Cells(x, 2).Value = Sh1.Cells(r, 2).Value
            Sh2.Cells(x, 3).Value = Sh1.Cells(r, 3).Value
            Sh2.Cells(x, 4).Value = Sh1.Cells(r, 4).Value
            Sh2.Cells(x, 5).Value = Sh1.Cells(r, 5).Value
            Sh2.Cells(x, 6).Value = Sh1.Cells(r, 6).Value
            Sh2.Cells(x, 7).Value = Sh1.Cells(r, 7).Value
            Sh2.Cells(x, 8).Value = Sh1.Cells(r, 8).Value
            Sh2.Cells(x, 9).Value = Sh1.Cells(r, 19).Value
            Sh2.Cells(x, 10).Value = Sh1.Cells(r, 29).Value
            Sh2.Cells(x, 11).Value = Sh1.Cells(r, 30).Value
            Sh2.Cells(x, 12).Value = Sh1.Cells(r, 31).Value
            Sh2.Cells(x, 13).Value = Sh1.Cells(r, 9).Value
            Sh2.Cells(x, 14).Value = Sh1.Cells(r, 14).Value
            Sh2.Cells(x, 15).Value = Sh1.Cells(r, 33).Value
            Sh2.Cells(x, 16).Value = Sh1.Cells(r, 16).Value
            x = x + 1
        End If
    Next r
    Sh2.Select
End Sub

Answer 1

在代码末尾添加以下内容。

Dim rngDB As Range

Set rngDB = Sh2.Range("a1").CurrentRegion
With rngDB
    .Sort .Range("b1"), xlAscending, Header:=xlYes
End With

Answer 2

Dy.Lee给您解决方案

在这里，我只想给您一些提示，以使您的代码更高效，（可能）更易读和可维护

Sub As_Of_Analysis_Sorting()

    Dim Sh1 As Worksheet, Sh2 As Worksheet
    Set Sh1 = ThisWorkbook.Worksheets("service")
    Set Sh2 = ThisWorkbook.Worksheets("Copy")

    Dim lr As Long, lr2 As Long, r As Long, x As Long

    With Sh2
        For x = 1 To 14
            .Cells(1, x).Value = x
        Next
    End With

    lr = Sh1.Cells(Rows.Count, "A").End(xlUp).Row
    x = 2
    With Sh1
        For r = 2 To lr
            If Range("C" & r).Value = "In Arbeit" Then
                Sh2.Cells(x, 1).Resize(, 16).Value = Array( _
                                                    .Cells(r, 1).Value, _
                                                    .Cells(r, 2).Value, _
                                                    .Cells(r, 3).Value, _
                                                    .Cells(r, 4).Value, _
                                                    .Cells(r, 5).Value, _
                                                    .Cells(r, 6).Value, _
                                                    .Cells(r, 7).Value, _
                                                    .Cells(r, 8).Value, _
                                                    .Cells(r, 19).Value, _
                                                    .Cells(r, 29).Value, _
                                                    .Cells(r, 30).Value, _
                                                    .Cells(r, 31).Value, _
                                                    .Cells(r, 9).Value, _
                                                    .Cells(r, 14).Value, _
                                                    .Cells(r, 33).Value, _
                                                    .Cells(r, 16).Value)
                x = x + 1
            End If
        Next
    End With

    Sh2.Select
End Sub

然后将Dy.Lee解决方案添加到底部

将数据从一张纸复制到另一张纸

2 个答案: