Um Transpose do Excel entre 2 símbolos específicos

Question

Estou tentando organizar registros de catálogo exportados de um programa muito desatualizado que minha biblioteca está usando para prepará-lo para importar para o novo catálogo. Os registros saem assim:

~#[K11

title[Yada Yada

date[19xx

Entry body text

Entry body text

Volume:1

Location: Outer Mongolia

]

E eu gostaria que eles se parecessem com isso tudo em uma linha transposta:

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

Os registros podem ou não ter todos os campos, mas todos começam com '# [' e todos terminam com ']'. Como essas são as únicas vezes em que esses símbolos aparecem, eu estava tentando escrever uma macro que descia pela coluna A, procurando esses símbolos e transpondo tudo entre eles. Mas eu não sou bom o suficiente, qualquer ajuda seria muito apreciada!

Editar: Eu estou começando do código tão respondido tão bem pelo @Excellll em outro post e é aqui que estou até agora:

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

No entanto, cada entrada não tem 5 linhas, então não posso usar Step 5 , e meus dados não são contíguos, portanto não posso usar COUNTA .

Alguma sugestão para um passo de tamanho variável entre os dois caracteres específicos?

    

Answer 1

A macro abaixo transforma os dados de entrada no formato que você especificou. Espero que os registros restantes de seu conjunto de dados tenham estrutura semelhante, ou seja, há espaço para modificações. Eu não tinha certeza sobre o sinal ~ como aparece na entrada, mas não na sua descrição. Isso pode ser resolvido modificando a variável 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