如何编写Excel VBA宏，按计算行数保留20%随机排序行并删除其余行？

方法一：读取预先计算好的目标行号 #

如果你已经通过工作表函数算出了需要保留到的行号（比如存在Sheet1的A1单元格），可以用以下宏直接读取并删除下方内容：

Sub DeleteRowsBelowTarget()
    Dim ws As Worksheet
    Dim keepUntilRow As Long
    
    ' 设定目标工作表，根据实际修改
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 读取预先计算好的行号（这里假设值存在A1单元格，可自行修改）
    keepUntilRow = ws.Range("A1").Value
    
    ' 检查目标行号是否有效，避免删除表头或空行
    If keepUntilRow < ws.Rows.Count And keepUntilRow >= 1 Then
        ' 删除目标行号下方的所有行
        ws.Rows(keepUntilRow + 1 & ":" & ws.Rows.Count).Delete
    End If
End Sub

方法二：直接在VBA中计算目标行号 #

如果不想预先用工作表函数计算，也可以直接在宏里完成总行数统计、20%向上取整、行号计算的整个流程：

Sub CalculateAndDeleteExcessRows()
    Dim ws As Worksheet
    Dim totalDataRows As Long
    Dim keepDataRows As Long
    Dim keepUntilRow As Long
    
    ' 设定目标工作表
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取不含表头的总行数（假设表头在第1行，数据从第2行开始）
    totalDataRows = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row - 1
    
    ' 计算需保留的数据行数：20%向上取整
    keepDataRows = Application.WorksheetFunction.Ceiling(totalDataRows * 0.2, 1)
    
    ' 计算保留到的行号（表头行+保留的数据行数）
    keepUntilRow = 1 + keepDataRows
    
    ' 删除超出部分的行
    If keepUntilRow < ws.Rows.Count Then
        ws.Rows(keepUntilRow + 1 & ":" & ws.Rows.Count).Delete
    End If
End Sub

关键说明 #

• 请根据你的实际工作表名称修改Sheet1，如果表头不在第1行，需要调整keepUntilRow的计算逻辑。
• 代码中加入了判断条件，避免在目标行已经是最后一行时执行无效操作。
• 方法二中的"A"代表数据所在的列（用于统计总行数），如果你的数据主列不是A列，需要修改这个参数。

内容的提问来源于stack exchange，提问作者Jroacher2