将文本拆分为Rown

时间:2018-11-28 07:37:14

标签: excel vba excel-vba

我正在使用Excel 2010,并且具有以下数据: enter image description here

您可以在一行中看到多个数据。

我对产品一的数据显示在这样的单元格中:

Product                                       1.600,00
Other                               1.600,00
EH-Price                                 3.200,00
Pos.-Price                               3.200,00

我想通过以下方式拆分数据:

enter image description here

我试图转置数据,然后用“空格”将其分离,然后再转回,但是由于有多行,所以效果不佳。

请在下面的测试文件中进一步查找:

Testing file

非常感谢您的答复!

1 个答案:

答案 0 :(得分:0)

尝试一下。

Sub Test()
    Dim vDB, vS, vR(), vHead()
    Dim Ws As Worksheet
    Dim n As Long, i As Long, j As Integer
    Dim r As Long, c As Integer, k As Integer
    Dim a As Integer, cnt As Integer

    Set Ws = ActiveSheet
    Ws.Cells.Replace ".", ""
    Ws.Cells.Replace ",", ""

    vDB = Ws.UsedRange
    r = UBound(vDB, 1)
    c = UBound(vDB, 2)

    '@@ get colum's number of data
    For i = 1 To c
        If vDB(2, i) <> "" Then
            k = k + 1
            ReDim Preserve vHead(1 To k)
            vHead(k) = i
        End If
    Next i
    n = 0
    '@@ Cycle the cell to see if chr(10) (vbNewline) is included.
    For i = 1 To r
        If InStr(vDB(i, 1), Chr(10)) Then '~~> if includ  chr(10)
            vS = Split(vDB(i, 1), Chr(10))
            cnt = UBound(vS)
            For a = 0 To cnt
                n = n + 1
                ReDim Preserve vR(1 To c, 1 To n)
                For j = 1 To k
                    vS = Split(vDB(i, vHead(j)), Chr(10))
                    If j = 1 Then
                        vR(vHead(j), n) = Split(vS(a))(0)
                    Else
                        vR(vHead(j), n) = Val(Trim(vS(a)))
                    End If
                Next j
            Next a
        Else '~~> if don't include  chr(10)
            n = n + 1
            ReDim Preserve vR(1 To c, 1 To n)
            vR(1, n) = vDB(i, 1)
        End If
    Next i
    Sheets.Add
    Range("a1").Resize(n, c) = WorksheetFunction.Transpose(vR)
    Range("J:O").NumberFormatLocal = "#,###"

End Sub