Excel транспонировать между 2 конкретными символами

Question

Я пытаюсь организовать записи каталога, экспортированные из очень устаревшей программы, которую использует моя библиотека, чтобы подготовить ее к импорту в новый каталог. Записи выходят так:

~#[K11

title[Yada Yada

date[19xx

Entry body text

Entry body text

Volume:1

Location: Outer Mongolia

]

И я бы хотел, чтобы они выглядели так, как показано на одной строке:

~#[K11 title[Yada Yada date[19xx Entry body text Entry body text Volume:1 Location: Outer Mongolia ]

Записи могут иметь или не иметь все поля, но все они начинаются с «# [», и все они заканчиваются на «]». Поскольку это единственный раз, когда появляются эти символы, я пытался написать макрос, который будет идти вниз по столбцу А, искать эти символы и переставлять все между ними. Но я не достаточно хорош, любая помощь будет принята с благодарностью!

Редактировать: я начинаю с кода, который так хорошо ответил @Excellll в другом посте, и вот где я до сих пор:

Dim n As Long
n =  30000
For i = 1 To n Step 5
    Range("A1:A5").Offset(i - 1, 0).Select
    Selection.Copy
    Range("B10").Offset((i - 1) / 5 + 1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Next I

Однако каждая запись не имеет 5 строк, поэтому я не могу использовать Step 5 , также мои данные не являются смежными, поэтому я не могу использовать COUNTA .

Любые предложения для шага переменного размера между двумя конкретными символами?

Answer 1

Приведенный ниже макрос преобразует входные данные в указанный вами формат. Надеемся, что остальные записи вашего набора данных будут иметь аналогичную структуру, иначе, конечно, есть место для изменений.
Я не совсем уверен насчет знака ~ как он появляется во входных данных, но не в вашем дальнейшем описании. Это может быть решено путем изменения переменной startString .

Option Explicit

Sub transpose()
Dim i As Long
Dim noOfRows As Long
Dim bc As String 'blank cell replacement
Dim startString As String
Dim endString As String
Dim record As String
Dim j As Long 'where to print record - row number
Const c As Long = 3 'where to print record - column number
Dim sheetname As String
Dim currentCellValue As String
Dim previousCellValue As String 'it is used to ignore multiple consecutive empty cells

startString = "~#["
endString = "]"
bc = " "
j = 1
sheetname = ActiveSheet.Name

'number of rows used in s/s including blanks in between
For i = Worksheets(sheetname).Rows.Count To 1 Step -1
    If Cells(i, 1).Value <> "" Then
        Exit For
    End If
Next i
noOfRows = i

'loop through all rows
For i = 1 To noOfRows
    currentCellValue = Cells(i, 1).Value
    'check if startsWith
    If InStr(Trim(currentCellValue), startString) = 1 Then
        record = currentCellValue
    'check if endsWith
    ElseIf Len(Trim(currentCellValue)) > 0 And Len(Trim(currentCellValue)) = InStrRev(Trim(currentCellValue), endString) Then
        record = record + currentCellValue
        'prints output records to the worksheet
        Cells(j, c).Value = record
        j = j + 1
        Debug.Print record
    ElseIf Len(Trim(currentCellValue)) = 0 And Len(Trim(previousCellValue)) > 0 Then
        record = record + bc
    'non blank cells which are between start and end strings
    ElseIf Len(Trim(currentCellValue)) > 0 Then
        record = record + currentCellValue
    End If
    previousCellValue = currentCellValue
Next i
End Sub