excel如何随机删除一个百万级的数据

410725273

Sub RndDelete()
Dim TotalRow As Long, NeedDel As Long, DelRate As Single, i As Integer, R As Long
Application.ScreenUpdating = False
ActiveCell.SpecialCells(xlLastCell).Select
While WorksheetFunction.CountA(Rows(ActiveCell.Row())) = 0 And ActiveCell.Row() > 1
ActiveCell.Offset(-1, 0).Range("A1").Select
Wend
Application.ScreenUpdating = True
TotalRow = ActiveCell.Row()
DelRate = Application.InputBox("当前有效数据为 " & TotalRow & " 行， 请输入需要删除的比率（%）", _
"随机删行", 10, , , , , 1)
If DelRate = 0 Then Exit Sub
NeedDel = DelRate / 100# * TotalRow
If MsgBox("将要删除的行数为 " & NeedDel & "！ 确定要这样做吗？", _
vbQuestion + vbYesNoCancel + vbDefaultButton2) <> vbYes Then Exit Sub
For i = 1 To NeedDel
R = Int((TotalRow * Rnd) + 1)
Cells(R, 1).EntireRow.Delete
TotalRow = TotalRow - 1
Next i
End Sub

现有代码如上↑ ，20W左右的数据可以删除，20W以上红色区域报错溢出6，求解决办法。