☰

两个特定符号之间的 Excel 转置

tag-icon • tag-icon microsoft-excel transpose
两个特定符号之间的 Excel 转置

我正在尝试整理从图书馆使用的非常过时的程序导出的目录记录，以便将其导入新目录。记录如下所示：

~#[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 ]

这些记录可能包含也可能不包含所有字段，但它们都以“#[”开头，并以“]”结尾。由于这些符号只出现在这些地方，所以我试图编写一个宏，它会沿着 A 列查找这些符号，并在它们之间转置所有内容。但我不够好，任何帮助都将不胜感激！

编辑：我从@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。

对于两个特定字符之间可变大小的步骤有什么建议吗？

答案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

相关内容