excel - Excel 宏，用于仅选择工作表中总行数的一半

Question

我想知道是否有人可以帮助我解决这个问题..

我在一张 Excel 表中有大约 500,000 行……而在其他表格中我有大约 600,000 行……

那么如何在 Excel 中只选择一半的行...

我的意思是假设总数是 500,000 行......那么我想只选择其中的一半，即 250,000 行......

并复制它并将其放入新文件并再次应用宏以选择其中的一半，即 125,000...

请建议如何做到这一点。

Answer 1

这段代码

• 用于Find识别特定工作表中真正的第一个和最后一个使用的行（我ws为工作表使用了一个变量，以防您想在非活动工作表上工作）

• 如果工作表不为空，则返回一个新范围，rng3该范围从第一个使用的行开始，并延伸第一行和最后一行之间距离的一半

  Sub GetHalfRows()
  Dim ws As Worksheet
  Dim rng1 As Range
  Dim rng2 As Range
  Dim rng3 As Range
  Set ws = ActiveSheet
  Set rng1 = ws.Cells.Find("*", ws.[a1], , , xlByRows, xlPrevious)
  Set rng2 = ws.Cells.Find("*", ws.Cells(Rows.Count, "A"), , , xlByRows, xlNext)
  If Not rng1 Is Nothing Then
      Set rng3 = ws.Range(rng2, rng2.Offset((rng1.Row - rng2.Row) / 2, 0)).EntireRow
      MsgBox "selected range is " & rng3.Address
  Else
      MsgBox ws.Name & " is empty"
  End If
  End Sub
  

Answer 2

试试这个：

Sub CopyHalfRows()
  Dim TargetWorkbook As Workbook
  Dim HalfRows As Range

  On Error GoTo HalfRowsImpossible
    Set HalfRows = ActiveSheet.UsedRange.Resize _
      (ActiveSheet.UsedRange.Rows.Count \ 2)
  On Error GoTo 0
  If Not HalfRows Is Nothing Then
    Set TargetWorkbook = Workbooks.Add
    HalfRows.Copy
    ActiveSheet.PasteSpecial
  End If
  Exit Sub
HalfRowsImpossible:
  MsgBox "Cannot halve worksheet"
  On Error GoTo 0
End Sub