Vba 对几个单独的列进行排序

我想将这些列分开，然后按降序对每个列进行单独排序，将国家/地区列表粘贴到每个单独的产品列旁边，然后按产品列的降序值对两者进行排序

下面的代码对特定范围的命名单元格进行排序，但我想更改代码，使其寻址ActiveCell，然后使用偏移量函数，我认为这应该是可行的

            Paint   Wallpaper   Furniture   Cars    Bicycles    Newspapers  TVs
Argentina   11      32          34          10      35          50          28
Brazil      46      42          32          20      31          14          49
China       76      11          10          11      37          42          40
Mexico      13      7           26          48      26          25          20
Portugal    12      29          39          48      7           27          40
Singapore   8       17          14          3       23          45          25
Thailand    9       31          43          7       40          14          18
Turkey      48      15          48          11      24          29          2
Uruguay     14      15          38          25      10          36          19

---

不确定这是否是你的目标。假设您的数据在第一页中，以下代码将在第2页中生成以下结果：

代码：

Sub Macro2()

    Macro2 Macro

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

    Option Explicit

Sub Main()

    Application.ScreenUpdating = False
    Call CopyData
    Call SortData
    Application.ScreenUpdating = True

End Sub

Private Sub CopyData()

    Sheets(1).Select
    Dim lastRow As Integer
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim countries As Variant
    countries = Range(Cells(2, 1), Cells(lastRow, 1)).Value2

    Dim lastColumn As Integer
    lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

    Dim currentColumn As Integer
    For currentColumn = 2 To lastColumn
        Sheets(1).Select
        Dim header As String
        header = Sheets(1).Cells(1, currentColumn)
        Dim values As Variant
        values = Sheets(1).Range(Cells(2, currentColumn), Cells(lastRow, currentColumn)).Value2
        Sheets(2).Select
        Dim lastColSheet2 As Integer
        lastColSheet2 = GetLastColumn
        Sheets(2).Range(Cells(2, lastColSheet2), Cells(lastRow, lastColSheet2)).Value2 = countries
        Sheets(2).Range(Cells(2, lastColSheet2 + 1), Cells(lastRow, lastColSheet2 + 1)).Value2 = values
        Sheets(2).Cells(1, lastColSheet2 + 1) = header
    Next currentColumn

End Sub

Private Sub SortData()

    Dim lastRow As Integer
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim lastColumn As Integer
    lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

    Dim currentColumn As Integer
    For currentColumn = 1 To lastColumn Step 2
        Sheets(2).Sort.SortFields.Clear
        Sheets(2).Sort.SortFields.Add Key:=Cells(1, currentColumn + 1), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        With Sheets(2).Sort
            .SetRange Range(Cells(1, currentColumn), Cells(lastRow, currentColumn + 1))
            .header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

    Next currentColumn

End Sub

Private Function GetLastColumn() As Integer
    If Sheets(2).Cells(2, Columns.Count).End(xlToLeft).Column = 1 Then
            GetLastColumn = 1
        Else
            GetLastColumn = Sheets(2).Cells(2, Columns.Count).End(xlToLeft).Column + 1
        End If
End Function