Разделить текст на строку - PullRequest
0 голосов
/ 28 ноября 2018

Я использую 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

Я попытался транспонировать данные, а затем разделить их на «пробел», а затем транспонировать обратно, однако это не работает, так как есть несколько строк.

Пожалуйста, найдите далеепод тестовым файлом:

Тестовый файл

Я очень ценю ваши ответы!

1 Ответ

0 голосов
/ 28 ноября 2018

Попробуйте это.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...