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

前

后