Excel VBA для разбора строки

Question

Мне нужно написать модуль VBA, который:

1. Читает в строках на листе

2. Проверяет, имеет ли столбец E символ "; #", и анализирует строку для этого символа

3. Создает новую строку, копирует и вставляет содержимое строки из проанализированной строки в новую строку (обе строки будут иметь одинаковое содержимое)

4. Переименовывает исходный столбец в предшествующее слово; # "и переименовывает скопированный столбец в следующее слово"; # "

См. Пример с 3 столбцами:

Исходная строка: Строка A; # Строка B; #StringC (ячейка 1) Завершено (ячейка 2) 20.05.2009 (ячейка 3)

Что мне нужно, это:

Обновлено_Оригинальная строка: Строка A завершена 5/20/2019

Новая строка 1: Строка B завершена 5/20/2019

Новая строка 2: Строка C Завершено 5/20/2019

Я поиграл со следующим кодом, но он не работает:

Private Sub CommandButton1_Click()

Dim SplitText
Dim WrdArray() As String, size As Integer


'iterate through all the rows in the sheet
For i = 1 To i = 2000

'take one cell at a time
cell_value = ThisWorkbook.ActiveSheet.Cells(i, 1).Value
size = WorksheetFunction.CountA(Worksheets(1).Columns(1))

'Split cell contents
WrdArray() = Split(cell_value, vbLf)
For j = LBound(WrdArray) To UBound(WrdArray)
    Var = WrdArray()(0)
    Next j

  '  WrdArray().Resize(UBound(SplitText) + 1).Value = Application.Transpose(SplitText)
   ReDim WrdArray(size)
   counter = counter + 1

Var = SplitText

Далее я

End Sub

см. Изображение

Answer 1

Делая множество предположений, основываясь на том, что здесь кажется неполной информацией, но согласно предоставленной информации и примерам, что-то вроде этого должно работать для вас:

Sub tgr()

    Dim ws As Worksheet
    Dim rData As Range
    Dim aResults() As Variant
    Dim aData As Variant
    Dim vTemp As Variant
    Dim sTemp As String
    Dim ixResult As Long
    Dim i As Long, j As Long

    Set ws = ActiveWorkbook.ActiveSheet
    Set rData = ws.Range("A1").CurrentRegion
    If rData.Cells.Count = 1 Then
        ReDim aData(1 To 1, 1 To 1)
        aData(1, 1) = rData.Value
    Else
        aData = rData.Value
    End If

    ReDim aResults(1 To 65000, 1 To UBound(aData, 2))
    ixResult = 0

    For i = 1 To UBound(aData, 1)
        For Each vTemp In Split(Replace(aData(i, 1), ";#", ","), ",")
            If Len(Trim(vTemp)) > 0 Then
                ixResult = ixResult + 1
                aResults(ixResult, 1) = Trim(vTemp)
                For j = 2 To UBound(aData, 2)
                    aResults(ixResult, j) = aData(i, j)
                Next j
            End If
        Next vTemp
    Next i

    rData.Resize(ixResult).Value = aResults

End Sub

Answer 2

Пока вам не нужен столбец Title вашего скриншота в указанном вами порядке, это простая задача для Power Query (или Get & Transform в Excel 2016 +).

Всего

• Get&Transform Data от Table/Range
• Разделить по разделителю (и ваш разделитель выглядит как ;#, а не просто #
• Разбить на ряды

И все готово:

Это М-код для PQ:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Status", type text}, {"Priority", type text}, {"Name", type text}, {"Date", type date}}),
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(#"Changed Type", {{"Name", Splitter.SplitTextByDelimiter(";#", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Name"),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Name", type text}})
in
    #"Changed Type1"

Answer 3

Я решил использовать комбо из Len() и InStr(), чтобы определить, где в вашей строке указано "complete", чтобы определить содержание, добавляемое к каждой части разделения. Я сделал несколько предположений, касающихся ваших столбцов / строк (см. Изображение ниже):

Option Explicit

Sub fdsa()
    Dim arr As Variant, i As Long, s As Long, lr As Long, c As Long, z As String
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lr
        arr = Split(Cells(i, 1).Value, ",")
        If InStr(Cells(i, 1).Value, "Complete") Then z = Right(Cells(i, 1).Value, Len(Cells(i, 1).Value) - InStr(Cells(i, 1).Value, "Complete") + 1)
        c = 2
        For s = LBound(arr) To UBound(arr)
            If s = UBound(arr) Then z = ""
            Cells(i, c).Value = arr(s) & " " & z
            c = c + 1
        Next s
    Next i
End Sub

---

Вот данные, которые я использовал: