文件展开与合并

kaiguo

fbzs TD1482.rar (5 KB, 下载次数: 16)

2013-9-21 18:50 上传

点击文件名下载附件

原始：

展开后：

能展开也能合并的公式或则宏都可以

shuyee

最烦这种表达方式了
Sub Explode()
Dim tmpR As Range, i%, tmpStr$, tmpV As Variant, outArr As Variant, j%, k%
i = Range("B65536").End(xlUp).Row
If i < 5 Then Exit Sub
Set tmpR = Range("B5").Offset(0, -1).Resize(i - 4, 10)
tmpV = tmpR.Value
Set tmpR = Nothing
ReDim outArr(1 To 1000, 1 To 10)
k = 1
For i = 1 To UBound(tmpV)
    For j = 1 To 10
        outArr(k, j) = tmpV(i, j)
    Next
    k = k + 1
    tmpStr = tmpV(i, 6)
    j = InStr(1, tmpStr, " ", vbTextCompare)
    If j > 0 Then
        outArr(k - 1, 6) = Left(tmpStr, j - 1)
        tmpV(i, 6) = Mid(tmpStr, j + 1, 100)
        i = i - 1
    End If
Next
Sheet3.Range("A2").Resize(k, 10) = outArr
End Sub

linaangel1988

可以使用分级显示吧