VBA - Найти абзац, начинающийся с цифр

Question

Я использую сценарий VBA, чтобы попытаться найти начальный номер абзаца (это элементы списка, которые не отформатированы как таковые - не пытаются форматировать, просто найдите номера).

1. First Item
2. Second Item
No number - don't include despite 61.5 in paragraph.
25 elephants should not be included
12. Item Twelve, but don't duplicate because of Susie's 35 items

Есть ли способ сказать в VBA "Если в начале абзаца есть 1-2 числа, верните эти числа". В регулярных выражениях я ищу ^(\d\+)\.

Вот рабочий фрагмент кода VBA - еще не выяснили, как СОЗДАТЬ файл Excel, так что если вы go протестируете создание пустой test.xslx в вашей временной папке. Конечно, это может быть достаточно просто, чтобы тестирование не требовалось.

Sub FindWordCopySentence()
On Error Resume Next
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
Dim intRowCount As Integer
intRowCount = 1

' Open Excel File
If objSheet Is Nothing Then
    Set appExcel = CreateObject("Excel.Application")
     'Change the file path to match the location of your test.xls
    Set objSheet = appExcel.workbooks.Open("C:\temp\test.xlsx").Sheets("Sheet1")
    intRowCount = 1
End If

' Word Document Find
Set aRange = ActiveDocument.Range
With aRange.Find
    Do
        .ClearFormatting
        ' Find 1-2 digit number
        .Text = "[0-9]{1,2}"
        .MatchWildcards = True
        .Execute
        If .Found Then
            ' Copy to Excel file
            aRange.Expand Unit:=wdSentence
            aRange.Copy
            aRange.Collapse wdCollapseEnd
            objSheet.Cells(intRowCount, 1).Select
            objSheet.Paste
            intRowCount = intRowCount + 1
        End If
    Loop While .Found
End With
Set aRange = Nothing

If Not objSheet Is Nothing Then
    appExcel.workbooks(1).Close True
    appExcel.Quit
    Set objSheet = Nothing
    Set appExcel = Nothing
End If

End Sub

Спасибо!

Answer 1

Я бы go немного проще и просто проверил бы первые несколько символов абзаца:

Option Explicit

Sub test()
    Dim para As Paragraph
    For Each para In ThisDocument.Paragraphs
        With para.Range
            If (.Characters(2) = ".") Or (.Characters(3) = ".") Then
                If IsNumeric(para.Range.Words(1)) Then
                    Debug.Print "Do something with paragraph number " & _
                                 para.Range.Words(1) & "."
                End If
            End If
        End With
    Next para
End Sub

Answer 2

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

Sub Demo()
Application.ScreenUpdating = False
Dim StrOut As String
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13[0-9.]{1,}" ' or: .Text = "^13[0-9]{1,}
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    StrOut = StrOut & .Text
    ' or: MsgBox Split(.Text, vbCr)(1)
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox StrOut
End Sub

В кодированном виде макрос возвращает все строки списка, где может быть несколько уровней (например, 1.2). Комментарии показывают, как найти только первое число, где может быть несколько уровней, и как извлечь это число для тестирования (выражение «Найти» включает разрыв предыдущего абзаца).