Excel 在多个工作表上拆分数据

我有一个工作簿，里面有100多张工作表，我需要将单元格“D2”、“E2”、“F2”和“G2”中的数据拆分并放入这些行中的各个单元格中

我在互联网上浏览了所有可能的选择。唯一有效的方法是使用Kutools并将数据拆分为行，但我希望它同时处理所有行，而不是一次处理一行，并且可能自动处理每个工作表

我对编码非常陌生，不知道该去哪里

每个工作表都是一个数据表，第一行是标题，第二行包含数据。列D-G中的信息是通过使用alt+enter分隔的，但是我希望现在让他们将信息填充到该列中。在某些工作表中，只有D2中的信息，某些工作表的所有单元格中都有信息，而某些工作表的任何列中都没有信息

输入1:

预期输出1:

输入2:

预期产出2:

输入3:

预期产出3:

输入4:

预期产出4:

试试看

Sub test()
    Dim Ws As Worksheet
    For Each Ws In Worksheets
        SplitWs Ws
    Next Ws
End Sub
Sub SplitWs(Ws As Worksheet)
    Dim vDB, rngDB As Range
    Dim vR() As Variant, vS As Variant
    Dim r As Long, i As Long, n As Long
    Dim j As Integer, k As Integer, m As Integer
    Dim c As Integer, Cnt As Integer
    Dim vRow() As Variant

    Set rngDB = Ws.Range("a1").CurrentRegion
    If rngDB.Rows.Count < 2 Then Exit Sub
    vDB = rngDB
    r = UBound(vDB, 1)
    For i = 2 To r
        k = 0
        m = 0
        '@@ The maximum value of the number of times of alt + enter
        '   used in each cell of each line is obtained.
        For j = 1 To 7
            m = m + 1
            ReDim Preserve vRow(1 To m)
            s = vDB(i, j)
            If InStr(s, Chr(10)) Then
                vS = Split(s, Chr(10))
                vRow(m) = UBound(vS)
                k = WorksheetFunction.Max(vRow)
            End If
        Next j
        n = n + k + 1
        '@@ With the array size set, only the contents of the line
        '   in which the data is located in each cell are adjusted.
        ReDim Preserve vR(1 To 7, 1 To n)
        For c = 1 To 7
            Cnt = 0
            s = vDB(i, c)
            vS = Split(s, Chr(10))
            For j = 0 To UBound(vS)
                If vS(j) <> "" Then
                    Cnt = Cnt + 1
                    vR(c, n - k - 1 + Cnt) = vS(j)
                End If
            Next j
        Next c
    Next i
    With Ws
        .UsedRange.Offset(1).Clear
        .Range("a2").Resize(n, 7) = WorksheetFunction.Transpose(vR)
    End With

End Sub

子测试（）
将Ws设置为工作表
对于工作表中的每个Ws
分裂
下一个Ws
端接头
子拆分Ws（Ws作为工作表）
Dim vDB、rngDB As范围
Dim vR（）作为变量，vS作为变量
暗r一样长，i一样长，n一样长
尺寸j为整数，k为整数，m为整数
Dim c为整数，Cnt为整数
Dim vRow（）作为变量
设置rngDB=Ws.Range（“a1”）.CurrentRegion
如果rngDB.Rows.Count<2，则退出Sub
vDB=rngDB
r=UBound（vDB，1）
对于i=2到r
k=0
m=0
“@@alt+enter的最大次数值”
'在每行的每个单元格中使用。
对于j=1到7
m=m+1
ReDim保留vRow（1到m）
s=vDB（i，j）
如果仪表（s，Chr（10）），则
vS=分割（s，Chr（10））
vRow（m）=UBound（vS）
k=工作表函数最大值（vRow）
如果结束
下一个j
n=n+k+1
“@@1在设置了数组大小后，只有行的内容
'调整每个单元格中的数据所在位置。
重拨保留vR（1到7，1到n）
对于c=1到7
Cnt=0
s=vDB（i，c）
vS=分割（s，Chr（10））
对于j=0至UBound（vS）
如果vS（j）“，则
Cnt=Cnt+1
vR（c，n-k-1+Cnt）=vS（j）
如果结束
下一个j
下一个c
接下来我
与Ws
.UsedRange.Offset（1）.清除
.Range（“a2”）.Resize（n，7）=工作表函数转置（vR）
以
端接头

我谨向李迪致以敬意和敬意，并将其改写成本书

Option Explicit
Option Base 1

Sub test()
    Dim Ws As Worksheet
    For Each Ws In Worksheets
        SplitWs2 Ws
    Next Ws
End Sub

Sub SplitWs2(Ws As Worksheet)

    ' define the input
    Dim vIN() As Variant, colIN As Integer, rowIN As Integer
    vIN = Ws.Range("a1").CurrentRegion
    'MsgBox ("ub=" & UBound(vDB, 1) & " by " & UBound(vDB, 2))  ' 4 rows by 7 columns

    ' define the output, starting out same size as input, but transposed row/column
    ' we need to add rows, and can only redim the last dimension
    Dim vOUT() As Variant, colOUT As Integer, rowOUT As Integer
    ReDim Preserve vOUT(UBound(vIN, 2), UBound(vIN, 1))

    ' step thru the input, columns and rows
    For colIN = 1 To UBound(vIN, 2)  ' to the last column
        colOUT = colIN
        rowOUT = 0

        For rowIN = 1 To UBound(vIN, 1) ' to the last row

            ' look down column at each input cell for splits
            Dim s As String, vS As Variant, k As Integer, rowAdd As Integer
            s = vIN(rowIN, colIN)
            If InStr(s, Chr(10)) Then

                vS = Split(s, Chr(10))  '  vS is base zero, so add one to UBound
                rowAdd = rowOUT + UBound(vS, 1) + 1 - UBound(vOUT, 2)
                If rowAdd > 0 Then
                    ReDim Preserve vOUT(UBound(vOUT, 1), UBound(vOUT, 2) + rowAdd)
                End If

                For k = 0 To UBound(vS)
                    rowOUT = rowOUT + 1
                    vOUT(colOUT, rowOUT) = vS(k)
                Next k

            ElseIf s > "" Then
                ' found un-split data, so move it
                rowAdd = rowOUT + 1 - UBound(vOUT, 2)
                If rowAdd > 0 Then
                    ReDim Preserve vOUT(UBound(vOUT, 1), UBound(vOUT, 2) + rowAdd) As Variant
                End If

                rowOUT = rowOUT + 1
                vOUT(colOUT, rowOUT) = s
            'Else it is blank and skip that input cell
            End If

        Next rowIN
    Next colIN
    MsgBox (Ws.Name & "  vOUT + " & UBound(vOUT, 1) & " by " & UBound(vOUT, 2))

    With Ws
        .UsedRange.Clear
        .Range("A1").Resize(UBound(vOUT, 2), UBound(vOUT, 1)) = WorksheetFunction.Transpose(vOUT)
    End With



End Sub

---

请与我们共享两个或三个工作表的输入，并使用两个或三个输入的数据格式化预期输出。这将消除一些混乱，并帮助我们提出解决实际问题的方案。输入时是否将输出放在同一张纸上？或者在新工作簿中创建100张新工作表？或者被收集到一个累积输出表中？这基本上是去除了任何单元格数据上的空白单元格？是的，我希望输出在同一片上。在VR（C，N-K—1 +CNT）＝Vs（j）@ TimSwadley上说“超出范围”，这是因为ALT+Enter的次数对于每个单元格是不同的。之前的代码是在相同的判断下制定的，但它被修改为在不同的情况下应用。我已经修改了你的答案，并给了你这个概念的信任。