从Word到Excel的多级列表

Question

我需要的结果是将MS Word中的多级列表分布在excel中的列中，然后将多级列表指示符移动到自己的列中。现在，我的代码删除了多级列表指示符。我有一个解决方案，但它不适用于a.到z的多级列表指示符，因为句子末尾有一个字母和句点，代码正在删除句子的最后一个字母。我需要为代码选择字母句点或数字句点到左边，字符串的开头。我也不能得到方括号"；[]"；作为一个字符串来阅读，我必须声明每一次出现。有没有一种方法可以识别"；[]"；作为字符串的一部分？此代码将多级列表复制到正确的列中。我需要它只移动如果数字或字母的内容。示例：1。或a.或(1(或(a(或1或[a]在字符串的开头。这是我用来根据多级列表指示符移动单元格内容的代码。我使用的第二个代码是在多级列表移动到列之后删除它。最终，我想将多级列表指示符移动到其内容的同一行上的自己的列中。最后，我想移动多级(示例：1。或a.或(1(或(a(或1或[a](插入到该级别的内容旁边的列中。单词中的多级列表

单词列表复制并粘贴到excel 中

1.这是一级。a.这是2级。删除列表指示器时，最后一个字母和句点将消失。(1( 这是3级。(a( 这是4级。1这是5级。如何在字符串中使用方括号。[a] 这是6级。1( 这是7级。

excel期望输出

Sub Findandcut()
Dim row As Long
For row = 1 To 1000
If Range("A" & row).Value Like "(#)" Then
' Copy the value and then blank the source.
Range("C" & row).Value = Range("A" & row).Value
Range("A" & row).Value = ""
End If
If Range("A" & row).Value Like "[a-z].*" Then
' Copy the value and then blank the source.
Range("B" & row).Value = Range("A" & row).Value
Range("A" & row).Value = ""
End If
If Range("A" & row).Value Like "(#)*" Then
' Copy the value and then blank the source.
Range("C" & row).Value = Range("A" & row).Value
Range("A" & row).Value = ""
End If
If Range("A" & row).Value Like "([a-z])*" Then
' Copy the value and then blank the source.
Range("D" & row).Value = Range("A" & row).Value
Range("A" & row).Value = ""
End If
Next

结束子

Sub remove_BulletsCol_B()
Dim str1 As String
Dim str2 As String
Dim rngTemp As Range
Dim rngCell As Range
str1 = "a."
str2 = "b."
str3 = "c."
str4 = "d."
str5 = "e."
str6 = "f."
str7 = "g."
str8 = "h."
str9 = "i."
str10 = "j."
str11 = "k."
str12 = "l."
str13 = "m."
str14 = "n."
str15 = "o."
str16 = "p."
str17 = "q."
str18 = "r."
str19 = "s."
str20 = "t."
str21 = "u."
str22 = "v."
str23 = "w."
str24 = "x."
str25 = "y."
str26 = "z."
'Set rngTemp
Set rngTemp = Cells(1, 1).CurrentRegion 'You range goes here
'Loop through range and replace string
For Each rngCell In rngTemp
If InStr(1, rngCell, str1) > 0 Then
rngCell = Replace(rngCell.Value, str1, "")
End If
If InStr(1, rngCell, str2) > 0 Then
rngCell = Replace(rngCell.Value, str2, "")
End If
If InStr(1, rngCell, str3) > 0 Then
rngCell = Replace(rngCell.Value, str3, "")
End If
If InStr(1, rngCell, str4) > 0 Then
rngCell = Replace(rngCell.Value, str4, "")
End If
If InStr(1, rngCell, str5) > 0 Then
rngCell = Replace(rngCell.Value, str5, "")
End If
If InStr(1, rngCell, str6) > 0 Then
rngCell = Replace(rngCell.Value, str6, "")
End If
If InStr(1, rngCell, str7) > 0 Then
rngCell = Replace(rngCell.Value, str7, "")
End If
If InStr(1, rngCell, str8) > 0 Then
rngCell = Replace(rngCell.Value, str8, "")
End If
If InStr(1, rngCell, str9) > 0 Then
rngCell = Replace(rngCell.Value, str9, "")
End If
If InStr(1, rngCell, str10) > 0 Then
rngCell = Replace(rngCell.Value, str10, "")
End If
If InStr(1, rngCell, str11) > 0 Then
rngCell = Replace(rngCell.Value, str11, "")
End If
If InStr(1, rngCell, str12) > 0 Then
rngCell = Replace(rngCell.Value, str12, "")
End If
If InStr(1, rngCell, str13) > 0 Then
rngCell = Replace(rngCell.Value, str13, "")
End If
If InStr(1, rngCell, str14) > 0 Then
rngCell = Replace(rngCell.Value, str14, "")
End If
If InStr(1, rngCell, str15) > 0 Then
rngCell = Replace(rngCell.Value, str15, "")
End If
If InStr(1, rngCell, str16) > 0 Then
rngCell = Replace(rngCell.Value, str16, "")
End If
If InStr(1, rngCell, str17) > 0 Then
rngCell = Replace(rngCell.Value, str17, "")
End If
If InStr(1, rngCell, str18) > 0 Then
rngCell = Replace(rngCell.Value, str18, "")
End If
If InStr(1, rngCell, str19) > 0 Then
rngCell = Replace(rngCell.Value, str19, "")
End If
If InStr(1, rngCell, str20) > 0 Then
rngCell = Replace(rngCell.Value, str20, "")
End If
If InStr(1, rngCell, str21) > 0 Then
rngCell = Replace(rngCell.Value, str21, "")
End If
If InStr(1, rngCell, str22) > 0 Then
rngCell = Replace(rngCell.Value, str22, "")
End If
If InStr(1, rngCell, str23) > 0 Then
rngCell = Replace(rngCell.Value, str23, "")
End If
If InStr(1, rngCell, str24) > 0 Then
rngCell = Replace(rngCell.Value, str24, "")
End If
If InStr(1, rngCell, str25) > 0 Then
rngCell = Replace(rngCell.Value, str25, "")
End If
If InStr(1, rngCell, str26) > 0 Then
rngCell = Replace(rngCell.Value, str26, "")
End If

下一个rngCell

结束子

Answer 1

尝试

Option Explicit
Sub Findandcut()
Dim wb As Workbook, ws As Worksheet
Dim r As Long, level As Integer
Dim s As String, n As String, ar
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)

For r = 1 To 1000
s = Left(ws.Cells(r, "A"), 20)
If Len(s) > 0 Then
' split off the paragrah number
ar = Split(s, " ")
n = ar(0)
level = 0
' remove brackets
If InStr(1, n, "[") Then
level = 5
n = Replace(n, "[", "")
n = Replace(n, "]", "")
ElseIf InStr(1, n, "(") Then
level = 3
n = Replace(n, "(", "")
n = Replace(n, ")", "")
ElseIf ar(0) Like "*." Then
level = 1
n = Replace(n, ".", "")
End If

If level > 0 Then
' check if n not numeric
If Not IsNumeric(n) Then
level = level + 1
End If
' remove number and move to column
ws.Cells(r, level + 1) = Mid(s, 2 + Len(ar(0)))
ws.Cells(r, 1) = ""
End If

End If
Next
End Sub