[已解决]《以解决》把一组数拆分到单个单元格显示！！

neicezhanghao

如图 如题

最佳答案

月排行榜 / 总排行榜

sd2605061

2016-7-20 13:47

Sub 拆分()
    Dim arr(), brr(1 To 100, 1 To 3), i As Integer, j As Integer, k As Integer, m As Integer, iRows As Integer
    Range("G6,L6,Q6") = 1
    iRows = Range("C6").CurrentRegion.Rows.Count
    Range("G6,L6,Q6").ClearContents
    arr = Range("C6:U" & iRows + 6)
    For j = 1 To UBound(arr, 2)
        If arr(1, j) = "数据" Then
            k = k + 1
            For i = 2 To UBound(arr, 1)
                If arr(i, j) = "" Then Exit For
                For m = 1 To 3
                    brr(i - 1, m) = Mid(arr(i, j), m, 1)
                Next m
            Next i
            Cells(7, 5 * k - 1).Resize(iRows, 3) = brr
            Erase brr
        End If
    Next j
End Sub

跳转到最佳答案楼层

sd2605061

Sub 拆分()
    Dim arr(), brr(1 To 100, 1 To 3), i As Integer, j As Integer, k As Integer, m As Integer, iRows As Integer
    Range("G6,L6,Q6") = 1
    iRows = Range("C6").CurrentRegion.Rows.Count
    Range("G6,L6,Q6").ClearContents
    arr = Range("C6:U" & iRows + 6)
    For j = 1 To UBound(arr, 2)
        If arr(1, j) = "数据" Then
            k = k + 1
            For i = 2 To UBound(arr, 1)
                If arr(i, j) = "" Then Exit For
                For m = 1 To 3
                    brr(i - 1, m) = Mid(arr(i, j), m, 1)
                Next m
            Next i
            Cells(7, 5 * k - 1).Resize(iRows, 3) = brr
            Erase brr
        End If
    Next j
End Sub

望帝春心

数据是像你表中这样排布的？数据行数多少有什么关系，不要这么模拟，让人费解，数据原样是什么样的就什么样，截取部分就行，你懂我的意思吗？

yorkchenshunan

见附件

neicezhanghao

望帝春心 发表于 2016-7-20 11:58
数据是像你表中这样排布的？数据行数多少有什么关系，不要这么模拟，让人费解，数据原样是什么样的就什么样 ...

是不是 最后一个空 的 误导您了啊？
简单的的说吧
下图就是 原始数据 用VBA 自动 分开 显示  您就按这个帮我写吧！！！

neicezhanghao

yorkchenshunan 发表于 2016-7-20 12:15
见附件

数据 发生变化后 结果 不对啊！！！

neicezhanghao

yorkchenshunan 发表于 2016-7-20 12:15
见附件

其中 某个 数据 只有 一个单元格内有数 就错误了

neicezhanghao

yorkchenshunan 发表于 2016-7-20 12:15
见附件

以解决 谢谢 您了

neicezhanghao

望帝春心 发表于 2016-7-20 11:58
数据是像你表中这样排布的？数据行数多少有什么关系，不要这么模拟，让人费解，数据原样是什么样的就什么样 ...

以解决 谢谢 您了