Word VBA 查找和替换

Question

我试图在我的表格的第 2 列中找到具有特定文本“0.118”的所有单元格，并为该行执行命令列表我还试图从该选定文本的第 5 列中获取值行并减去我在该行的输入框中输入的值。

我遇到的问题是它只更改了我找到的“0.118”中的一个，而不是每行中的全部。

而且我不知道如何搜索该选定行的 column(5)。

任何帮助将不胜感激。

谢谢你。

Sub ConvertTo_3MM()

Dim oTable As Table
Dim stT As Long, enT As Long
Dim stS As Long, enS As Long

With Selection.Find
    
    .Forward = True
    .MatchPhrase = True
    .Execute FindText:="0.118"
            
End With
    
For Each oTable In ActiveDocument.Tables
    
    Do While Selection.Find.Execute = True

        stT = oTable.Range.Start
        enT = oTable.Range.End

        stS = Selection.Range.Start
        enS = Selection.Range.End

        If stS < stT Or enS > enT Then Exit Do

        Selection.Collapse wdCollapseStart

        If ActiveDocument.Tables.Count >= 1 Then
            With ActiveDocument.Tables(1).Cell(nRow, 2).Range
                .Text = "3 MM" & vbCrLf & "-" & vbCrLf & "6 MM"
            End With
        End If

        Selection.MoveRight Unit:=wdCell
        
        If ActiveDocument.Tables.Count >= 1 Then
            With ActiveDocument.Tables(1).Cell(nRow, 3).Range
                .InsertAfter Text:=vbCrLf & "-" & vbCrLf & "SHANK"
            End With
        End If

        Selection.MoveRight Unit:=wdCell
        Selection.MoveRight Unit:=wdCell
                                       
        response = InputBox("Cut Length For 3 MM")

        If ActiveDocument.Tables.Count >= 1 Then
            With ActiveDocument.Tables(1).Cell(nRow, 5).Range
                .Text = response & vbCrLf & "-" & vbCrLf & (column(5).value - response)
            End With
        End If
                                 
        Selection.Find.Execute Replace:=wdReplaceAll
                    
    Loop
            
    Selection.Collapse wdCollapseEnd
            
Next
    
    Application.ScreenUpdating = True
    
End Sub

Answer 1

如果您问题中的代码实际上做了任何事情，因为它甚至无法编译，我会感到非常惊讶。

您的代码相当混乱，因此我不完全确定我是否正确理解了您要执行的操作，但是请尝试以下操作：

Sub ConvertTo_3MM()
    Application.ScreenUpdating = False

    Dim oTable As Table
    Dim response As String
    
    For Each oTable In ActiveDocument.Tables
        With oTable.Range
            With .Find
                .Forward = True
                .MatchPhrase = True
                .Text = "0.118"
                .Wrap = wdFindStop
                .Execute
            End With

            Do While .Find.Found = True
                .Text = "3 MM" & vbCr & "-" & vbCr & "6 MM"
                With .Rows(1)
                    .Cells(3).Range.InsertAfter Text:=vbCr & "-" & vbCr & "SHANK"
                    response = Val(InputBox("Cut Length For 3 MM"))
                    With .Cells(5).Range
                        .Text = response & vbCr & "-" & vbCr & (Val(.Text) - response)
                    End With
                End With
                .Collapse wdCollapseEnd
                .Find.Execute
            Loop
        End With
    Next
    
    Application.ScreenUpdating = True
    
End Sub

Answer 2

这可能不是解决方案，但我确实看到了一些问题：

你做：

For Each oTable In ActiveDocument.Tables

然后你在那个循环中做：

    Do While Selection.Find.Execute = True

但是这个Find将不限于For Each循环的表。

虽然无害，但在此Do While循环中，您可以执行以下操作：

        If ActiveDocument.Tables.Count >= 1 Then

但当然这是true因为For Each已经确定至少有 1 个表。

我建议您查找Find的文档，重新思考逻辑，然后在调试器中逐步运行它以查看代码在做什么。

Answer 3

试试这个代码：

Sub ConvertTo_3MM()
    Dim oTable As Table, rng As Range
    Dim nRow As Long, response As String
    
    For Each oTable In ActiveDocument.Tables
        With oTable
            Set rng = .Range
            Do
                If rng.Find.Execute("0.118") Then
                    If rng.Information(wdEndOfRangeColumnNumber) = 2 Then
                        nRow = rng.Information(wdEndOfRangeRowNumber)
                        .Cell(nRow, 2).Range.Text = "3 MM" & vbCrLf & "-" & vbCrLf & "6 MM"
                        .Cell(nRow, 3).Range.InsertAfter Text:=vbCrLf & "-" & vbCrLf & "SHANK"
                        response = Val(InputBox("Cut Length For 3 MM"))
                        .Cell(nRow, 5).Range.Text = response & _
                            vbCrLf & "-" & vbCrLf & (Val(.Cell(nRow, 5).Range.Text) - response)
                    End If
                Else
                    Exit Do
                End If
                rng.Collapse wdCollapseEnd
            Loop
        End With
    Next
    Application.ScreenUpdating = True
End Sub

前

后