在Excel 2007中拆分單元格

Question

我有一個巨大的Excel文件（2 MB），其中包含一個單元格中的多行數據。 有關詳細信息，請參見屏幕截圖。 我運氣不好，試圖將它們拆分為自己的行。 我正在使用我從Stackoverflow上的另一篇文章中獲得的VB腳本。 當我在各個列上運行時，應用程序掛起。 有沒有一種方法可以將每列中的單元格拆分成自己的行？

Sub JustDoIt()
    'working for active sheet
    'copy to the end of sheets collection
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Dim tmpArr As Variant
    Dim Cell As Range
    For Each Cell In Range("C1", Range("C2").End(xlDown))
        If InStr(1, Cell, Chr(10)) <> 0 Then
            tmpArr = Split(Cell, Chr(10))

            Cell.EntireRow.Copy
            Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _
                EntireRow.Insert xlShiftDown

            Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr)
        End If
    Next
    Application.CutCopyMode = False
End Sub

非常感謝您的幫助，在此先感謝您。

Answer 1

如果我正確理解了您的問題，則可以通過以下操作解決此問題：

1. 取消合並的單元格。

2. 例如，假設您要修改的列是A列。在A列的右側插入一個新列。然后使用以下公式：

   = IF（A2 <>“”“，A2，B1）

向下應用此公式將為您提供所需的格式。

Answer 2

該宏在編程上似乎可行。 但是，這可能會崩潰，因為您的數據太多了。 我認為最好的方法是從上面創建一個子例程，並在您的單元格上逐個調用它。 請在下面查看我的嘗試。

碼：

Sub SplitLine(SrcRng As Range, TargetRng As Range)

    StrToSplit = SrcRng.Value
    If InStr(1, StrToSplit, Chr(10)) Then
        SplitArr = Split(StrToSplit, Chr(10))
        With TargetRng
            .Resize(UBound(SplitArr) + 1, 1).Value = Application.Transpose(SplitArr)
        End With
    End If

End Sub

給定以下數據：

我將這樣調用上面的代碼：

Sub Test()

    Dim SourceSh As Worksheet, TargetSh As Worksheet
    Dim SourceRng As Range, CellRng As Range
    Dim TargetRng As Range

    With ThisWorkbook
        Set SourceSh = .Sheets("Sheet3")
        Set TargetSh = .Sheets("Sheet4")
    End With

    Set SourceRng = SourceSh.Range("A1:D1")
    Set TargetRng = TargetSh.Range("A1")

    Application.ScreenUpdating = False
    For Each CellRng In SourceRng
        SplitLine CellRng, TargetRng
        Set TargetRng = TargetRng.Offset(0, 1)
    Next
    Application.ScreenUpdating = True

End Sub

結果如下：

讓我們知道是否有幫助。