Question

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

“24.00（小时）”

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

我需要提取的第二个细胞有点难度。它看起来像这样：

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

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

持续时间需要进入J栏，费率需要分为K列和K列。升。

这是我目前的代码：

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 <中的最小值/ strong>，列 F 中的最大值，然后是公式： D3 ：=GetNthNumber(C3)
E3 ：=GetNthNumber(C3,1)
F3 ：=GetNthNumber(C3,2)

如果文字行包含＆＃34;天＆＃34;您可以执行更多操作。为了时间。

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）块中更改几行到下面：< p>

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

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

1 个答案: