仅将 Word 表格单元格中的数字提取到 Excel 单元格中

Question

我在 word 文档中有一个表格，我只需要从中提取数字。文档中有 2 个单元格，第一个单元格中包含以下字符串：

“24.00（小时）”

我只需要其中的数字“24”。它并不总是 2 位数，因为它是几个小时的持续时间。它可能超过 100。但通常是“xxx.xxx”格式。

我需要从中提取的第二个单元格有点困难。它看起来像这样：

“每小时 125.00 美元到 140.00 美元”

我需要提取“125”并将其放置在 Excel 中的一个单元格中，然后提取“140”并将其放置在另一个单元格中。这些数字总是介于“$”和“.00”之间，由“to”分隔。

持续时间需要进入 J 列，费率需要分隔到 K 列和 L 列。

这是我当前的代码：

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iTable As Integer  'table number index
Dim iRow As Long     'row index in Excel
Dim iCol As Integer  'column index in Excel

wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

Worksheets("Request Detail").Activate 'activates sheet of specific name


With wdDoc
TableNo = wdDoc.tables.Count
If TableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number of table to import", "Import Word Table", "1")
End If

For iTable = 1 To TableNo

       Dim lRow As Long
       lRow = Range("A" & Rows.Count).End(xlUp).Offset(1).Row + 1

        With .tables(TableNo)


            Cells(lRow - 1, "A") = WorksheetFunction.Clean(.cell(14, 2).Range.Text) 'polaris id
            Cells(lRow - 1, "B").Value = Date                                       'post current date
            Cells(lRow - 1, "C") = WorksheetFunction.Clean(.cell(16, 2).Range.Text) 'resource manager name
            Cells(lRow - 1, "D") = WorksheetFunction.Clean(.cell(15, 2).Range.Text) 'requestor name
            Cells(lRow - 1, "E") = WorksheetFunction.Clean(.cell(1, 2).Range.Text)  'customer name
            Cells(lRow - 1, "H") = WorksheetFunction.Clean(.cell(7, 2).Range.Text)  'start date
            Cells(lRow - 1, "I") = WorksheetFunction.Clean(.cell(8, 2).Range.Text)  'end date
            Cells(lRow - 1, "J") = WorksheetFunction.Clean(.cell(9, 2).Range.Text)  'duration
            Cells(lRow - 1, "K") = WorksheetFunction.Clean(.cell(12, 2).Range.Text)  'request low rate
            Cells(lRow - 1, "L") = WorksheetFunction.Clean(.cell(12, 2).Range.Text)  'request high rate


            'Cells(lRow - 1, "S") = WorksheetFunction.Clean(.cell(3, 2).Range.Text)  need to post name of negotiatoe

        End With

Next iTable
End With

Set wdDoc = Nothing

End Sub

这是我所指的表格部分的示例：

Answer 1

试试这个 UDF 并根据您的需要进行修改。如果一行文本中的第 N 个数字不匹配，则返回负数 (-1)。

假设 Word 单元格中的文本已放入 Excel 范围（例如 C3），小时数存储在 D 列中，速率最小值在 E，F 列中的最大速率，然后是：
D3 中的公式：=GetNthNumber(C3)
E3：@987654322 @
F3：=GetNthNumber(C3,2)

如果文本行包含时间的“天”，您可以做更多。

Option Explicit

Function GetNthNumber(oItem As Variant, Optional Nth As Long) As Double
    Dim sText As String, n As Long, i As Long, oTmp As Variant
    n = Nth
    ' Set to First if argument "Nth" is not passed in
    If n <= 0 Then n = 1
    ' Retrieve the text from the input item
    Select Case TypeName(oItem)
        Case "Range":   sText = oItem.Text
        Case "String":  sText = oItem
        Case Else:      sText = CStr(oItem)
    End Select
    i = 0 ' Initialize counter
    ' Loop through all the words in the text
    For Each oTmp In Split(sText, " ")
        ' Process only if the word is a number
        If IsNumeric(oTmp) Then
            i = i + 1
            ' Check if it's the Nth number
            If i = n Then
                sText = oTmp
                Exit For
            End If
        End If
    Next
    ' Return -1 if there isn't an answer
    If Not IsNumeric(sText) Then sText = "-1"
    GetNthNumber = CDbl(sText)
End Function

---

更新
对于您感兴趣的内容，首先将我上面的代码粘贴到新模块或现有代码的底部，然后将 With .tables(TableNo) 块中的几行更改为以下内容：

Cells(lRow - 1, "J").Value = GetNthNumber(WorksheetFunction.Clean(.cell(9, 2).Range.Text))  'duration (Time to Book?)
Cells(lRow - 1, "K").Value = GetNthNumber(WorksheetFunction.Clean(.cell(12, 2).Range.Text), 1) 'request low rate
Cells(lRow - 1, "L").Value = GetNthNumber(WorksheetFunction.Clean(.cell(12, 2).Range.Text), 2) 'request high rate