Question

为了执行上述任务，我在此处遵循了一些答案，并发现最适合我的任务的代码如下：

Option Explicit

Const strText2 As String = "FUNDS"

Sub ColSearch_DelRows()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim strFirstAddress As String
    Dim lAppCalc As Long
    Dim bParseString As Boolean

    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search for " & strText1, "User range selection", ActiveSheet.UsedRange.Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub

    'Further processing of matches
    bParseString = True

    With Application
        lAppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set cel1 = rng1.Find(strText2, , xlValues, xlPart, xlByRows, , False)
    'A range variable - rng2 - is used to store the range of cells that contain the string being searched for
    If Not cel1 Is Nothing Then
        Set rng2 = cel1
        strFirstAddress = cel1.Address
        Do
            Set cel1 = rng1.FindNext(cel1)
            Set rng2 = Union(rng2.EntireRow, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    'Further processing of found range if required
    If bParseString Then
        If Not rng2 Is Nothing Then
            With rng2
                .Font.Bold = True
                .Offset(1, 0).EntireRow.Insert
            End With
        End If
    End If

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With
End Sub

现在代码的问题在于，当它找到两个连续的行（使用搜索查询 - 资金）时，它会在第一行之后插入两个空白行，在第二行之后插入空行。

有人可以帮助我找到此代码中的问题吗？我插入新行的行是：.Offset(1, 0).EntireRow.Insert

由于

Answer 1

也许我在这里遗漏了一些东西，但听起来你的目标是：

提示用户输入范围
使用值＆＃34; FUNDS＆＃34;
将这些单元格的文本设为粗体
在＆＃34; FUNDS＆＃34;

以下将会这样做：

Option Explicit
Const searchstring As String = "FUNDS"

Sub ColSearch_DelRows()
Dim rng1 As Range
Dim ACell As Range

'Get working range from user
On Error Resume Next
Set rng1 = Application.InputBox("Please select range to search for " & searchstring, "User range selection", ActiveSheet.UsedRange.Address(0, 0), , , , , 8)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each ACell In rng1
    If (ACell.Value = searchstring) Then
        ACell.Font.Bold = True
        ACell.Offset(1, 0).EntireRow.Insert
    End If
Next ACell

End Sub

VBA宏在找到文本后插入行

1 个答案: