Question

我有一个宏，该宏将从多个工作表中搜索我的销售数据以查找特定项目，然后将该项目的所有销售显示到另一个工作表中。它工作正常，但现在我希望它对日期列（A列）进行排序

我需要在此代码中添加什么才能按日期（最新到最旧）进行排序

任何帮助将不胜感激

谢谢！史蒂夫

Option Compare Text

Sub finddata()

Application.ScreenUpdating = False

Dim datasheet1 As Worksheet
Dim datasheet2 As Worksheet
Dim datasheet3 As Worksheet
Dim datasheet4 As Worksheet
Dim datasheet5 As Worksheet
Dim datasheet6 As Worksheet
Dim reportsheet As Worksheet
Dim itemname As String
Dim finalrow As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer

Set datasheet1 = Sheet6
Set datasheet2 = Sheet5
Set datasheet3 = Sheet4
Set datasheet4 = Sheet3
Set datasheet5 = Sheet2
Set datasheet6 = Sheet1
Set reportsheet = Sheet7
itemname = reportsheet.Range("B2").Value

datasheet2.Visible = xlSheetVisible
datasheet3.Visible = xlSheetVisible
datasheet4.Visible = xlSheetVisible
datasheet5.Visible = xlSheetVisible
datasheet6.Visible = xlSheetVisible

reportsheet.Range("A5:N100").ClearContents

datasheet1.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To finalrow
    If Cells(i, 2) = itemname Then
    Range(Cells(i, 1), Cells(i, 14)).Copy
    reportsheet.Select
    Range("A100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    datasheet1.Select
    End If
Next i

datasheet2.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For j = 2 To finalrow
    If Cells(j, 2) = itemname Then
    Range(Cells(j, 1), Cells(j, 14)).Copy
    reportsheet.Select
    Range("A100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    datasheet2.Select
    End If
Next j

datasheet3.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For k = 2 To finalrow
    If Cells(k, 2) = itemname Then
    Range(Cells(k, 1), Cells(k, 14)).Copy
    reportsheet.Select
    Range("A100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    datasheet3.Select
    End If
Next k

datasheet4.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For l = 2 To finalrow
    If Cells(l, 2) = itemname Then
    Range(Cells(l, 1), Cells(l, 14)).Copy
    reportsheet.Select
    Range("A100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    datasheet4.Select
    End If
Next l

datasheet5.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For m = 2 To finalrow
    If Cells(m, 2) = itemname Then
    Range(Cells(m, 1), Cells(m, 14)).Copy
    reportsheet.Select
    Range("A100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    datasheet5.Select
    End If
Next m

datasheet6.Select
finalrow = Cells(Rows.Count, 1).End(xlUp).Row

For n = 2 To finalrow
    If Cells(n, 2) = itemname Then
    Range(Cells(n, 1), Cells(n, 14)).Copy
    reportsheet.Select
    Range("A100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
    datasheet6.Select
    End If
Next n

datasheet2.Visible = xlSheetHidden
datasheet3.Visible = xlSheetHidden
datasheet4.Visible = xlSheetHidden
datasheet5.Visible = xlSheetHidden
datasheet6.Visible = xlSheetHidden

reportsheet.Select

Range("H2").Select

End Sub

Answer 1

您可以使用以下代码对A列进行排序。您将需要用工作表名称替换“ Sheet1”。

Sub SortColA()
'
' Sort column A newest to oldest
'

'
    Columns("A:A").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A:A") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A:A")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

在我的Excel宏中按日期对列进行排序

1 个答案: