如何修改宏以使其排序？

Question

我们有一个小型读书俱乐部。我们读了这本书，然后给它评分。
为了跟踪书籍，我使用了一个宏，该宏将分数添加到最新书籍中，然后从最高点到最低点对列表进行排序。
我必须手动更新每本新书的字段。

我最近尝试使用以下方法自动化该过程：
.Cells(.Rows.Count,“A”).End(xlUp).row 的含义，它向上计数空单元格的数量，直到它到达一个包含一些数据的单元格，然后对其执行操作。
修改后的宏一直有效，直到它尝试对列表进行排序然后停止工作。

如何修改排序？

这是读书俱乐部文件：第 1 页。

这是读书俱乐部文件：第 2 页。

这是修改后的宏，在排序停止之前一直有效。

Sub PositionIndex()
 '
' PositionIndex Macro
' This macro sorts the ongoing position of the most popular books.
'
' Keyboard Shortcut: Ctrl+Shift+X

Dim wb As Workbook
Dim ws As Worksheet
Dim symbol As String
Dim n As Integer
Dim lastrow As Long

Sheets("Position Series").Select
Find the last used row in a Column: column K in this example

    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row
    End With
    
    MsgBox lastrow
       
    Dim DataRange As Range

    Set DataRange = Range("C7:K" & lastrow)
    DataRange.Select
    Selection.ClearContents
 
    Sheets("Time Series").Select
    'Find the last used row in a Column: column "Q" in this example
    
     With ActiveSheet
        lastrow = .Cells(.Rows.Count, "Q").End(xlUp).Row
    End With
    
    MsgBox lastrow
    
    Range("Q9:Q" & lastrow).Select
    Selection.Copy
    
    Sheets("Position Series").Select
    Range("K7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Time Series").Select
    'Find the last used row in a Column: column "I" in this example
    
     With ActiveSheet
        lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row
    End With
    
    MsgBox lastrow
    
    Range("C9:I" & lastrow).Select
    Selection.Copy
    Sheets("Position Series").Select
    Range("C7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Position Series").Select

    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row
    End With
    
    MsgBox lastrow
    
    Range("C7:K" & lastrow).Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Position Series").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Position Series").Sort.SortFields.Add Key:=Range( _
        "K7:K" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Position Series").Sort
        .SetRange = Range("C7:K" & lastrow).Select
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2").Select
    Sheets("Time Series").Select
    Range("A2").Select
    
End Sub

Answer 1

我真的很喜欢你的这个小项目 :)！ 我花了一些时间重写了代码，以便您了解正在发生的事情以及它如何变得更加稳定和高效。

我想我明白你想要达到的目标。

1 . - 您想定义排名的范围（K 列）：

ActiveWorkbook.Worksheets("Position Series").Sort.SortFields.Add Key:=Range( _
        "K7:K" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal

2 。 - 然后对定义范围右侧的列（日期、标题、作者、提议者）进行排序。

With ActiveWorkbook.Worksheets("Position Series").Sort
        .SetRange = Range("C7:K" & lastrow).Select
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With

这两部分可以改写为：

   Postion_Series.Range("C7:K" & lastrow).Sort key1:=Range("K7:K" & lastrow), _
   order1:=xlDescending, Header:=xlNo

---

我看到你有以下几行：

Sheets("Position Series").Select

你不需要那个。

首先我们定义您的工作表：

Dim Time_Series As Worksheet
Dim Postion_Series As Worksheet
Set Time_Series = ActiveWorkbook.Worksheets("Time Series")
Set Postion_Series = ActiveWorkbook.Worksheets("Position Series")

因此，每次我们使用变量 Time_Series 时，我们都指的是 Excel 工作表“时间序列”。 因此我们可以重写代码：

Sheets("Position Series").Select
'Find the last used row in a Column: column K in this example

    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row
    End With

为了更稳定和更高效的代码，因为您总是希望在这部分中 ActiveSheet 成为“职位系列”工作表，我们可以为此调用我们的变量 Postion_Series：

With Postion_Series
    lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row
End With

发生的情况是，我们告诉您的代码，您的代码行应该应用于变量 Postion_Series = 表示“将我引导到工作表“位置系列”并执行代码”，即 Sheets("Position Series").Select。

---

完整修订代码：

Sub PositionIndex()
 '
' PositionIndex Macro
' This macro sorts the ongoing position of the most popular books.
'
' Keyboard Shortcut: Ctrl+Shift+X

Dim wb As Workbook
Dim Time_Series As Worksheet
Dim Position_Series As Worksheet
Dim symbol As String
Dim n As Integer
Dim lastrow As Long

Set Time_Series = ActiveWorkbook.Worksheets("Time Series") 'Define the worksheet "Time Series" to a variable
Set Position_Series = ActiveWorkbook.Worksheets("Position Series") 'Define the worksheet "Position Series" to a variable

'Find the last used row in a Column: column K in this example
    With Position_Series
        lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row 'Find the last row for Column K in the worksheet "Position Series"
    End With
    
    MsgBox lastrow
       
    Dim DataRange As Range

    Set DataRange = Position_Series.Range("C7:K" & lastrow + 50) 'Define the datarange in the Sheet "Position Series" to clear the old data
    DataRange.ClearContents 'Clear the data for the defined range
 
'Find the last used row in a Column: column "Q" in this example
    With Time_Series
        lastrow = .Cells(.Rows.Count, "Q").End(xlUp).Row 'Find the last row for Column Q in the worksheet "Time Series"
    End With
    
    MsgBox lastrow
    
    'Copy column with Score rankings (column Q) from worksheet "Time Series" and paste it to "Position Series" for the column K, "Position"
    Time_Series.Range("Q9:Q" & lastrow).Copy 'Copy column until the last value
    'Paste the column to the new place
    Position_Series.Range("K7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    'Find the last used row in a Column: column "I" in this example
     With Time_Series
        lastrow = .Cells(.Rows.Count, "I").End(xlUp).Row 'Find the last row for Column I in the worksheet "Time Series"
    End With
    
    
    MsgBox lastrow
    'Copy relevant data about the Date, Title, Author, Propser for from the "Time Series" to the "Position Series"
    Time_Series.Range("C9:I" & lastrow).Copy
    'Paste it to the new place
    Position_Series.Range("C7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False 'This line will deselect the copy range. I think you should move to hear to deselect the copy range as soon you have pasting your data. So I moved the line to here.
    
    'Find the last row for Column K to decide which row to sort
    With Position_Series
        lastrow = .Cells(.Rows.Count, "K").End(xlUp).Row
        MsgBox lastrow
    End With

    Position_Series.Activate    
        'Sort the range "Range("C7:K" & lastrow)" by the values of column K. From Largest to Smallest, and the first row is not header.
        Position_Series.Range("C7:K" & lastrow).Sort key1:=Position_Series.Range("K7:K" & lastrow), _
        order1:=xlDescending, Header:=xlNo
    
End Sub