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