vba - Excel 删除所有空行 600 000 行并重新格式化

Question

我有一个包含 600 000 行的 Excel 文件。

看起来像这样:

1
2
3
4 Value1: 1
5 Value2: 2
6 Value3: 3
7
8
9
10 Value1: 1
11 Value2: 2
12 Value3: 3
13
14
15
...
599998: Value1: 1
599999: Value2: 2
600000: Value3: 3

我的目标是删除所有空行并放置如下值:

  A       B       C
1 Value1  Value2  Value3
2 ...

我尝试选择所有行 -> F5 特殊“空值”，但它总是说“选择太大”，即使有 1000 行......

任何能帮助我一点点的人，我将永远感激不已!

非常感谢!

Answer 1

您只需将这一行中的 SheetName 更改为数据所在工作表的名称:

    Set wS = ThisWorkbook.Sheets("SheetName")

这会将所需的输出放入新工作表中:

Sub testFrankLucas()
    Dim i As Long
    Dim LastRow As Long
    Dim wS As Worksheet
    Dim wsNew As Worksheet
    Dim DaTa() As Variant

    Set wS = ThisWorkbook.Sheets("SheetName")
    LastRow = LastRow_1(wS)
    ReDim DaTa(1 To 3, 1 To 1)

    For i = 1 To LastRow Step 6
        With wS
            DaTa(1, UBound(DaTa, 2)) = .Cells(i, 1).Offset(3, 0)
            DaTa(2, UBound(DaTa, 2)) = .Cells(i, 1).Offset(4, 0)
            DaTa(3, UBound(DaTa, 2)) = .Cells(i, 1).Offset(5, 0)
            ReDim Preserve DaTa(LBound(DaTa, 1) To UBound(DaTa, 1), LBound(DaTa, 2) To UBound(DaTa, 2) + 1)
        End With 'wS
    Next i
    ReDim Preserve DaTa(LBound(DaTa, 1) To UBound(DaTa, 1), LBound(DaTa, 2) To UBound(DaTa, 2) - 1)

    Set wsNew = ThisWorkbook.Sheets.Add
    'wsNew.Range("A1").Resize(UBound(DaTa, 2), UBound(DaTa, 1)).Value = Application.Transpose(DaTa)
    For i = LBound(DaTa, 2) To UBound(DaTa, 2)
        For j = LBound(DaTa, 1) To UBound(DaTa, 1)
            With wsNew
                .Cells(i, j).Value = DaTa(j, i)
            End With 'wsNew
        Next j
    Next i
End Sub


Public Function LastRow_1(wS As Worksheet) As Double
    With wS
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            LastRow_1 = .Cells.Find(What:="*", _
                                After:=.Range("A1"), _
                                Lookat:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Row
        Else
            LastRow_1 = 1
        End If
    End With
End Function