excel - 在 Excel 中的字符串后插入空白行

Question

我正在尝试在 Excel 2010 中创建一个宏，用于查找工作表中值为“所有客户”的每个单元格。每次找到该值时，我都需要在其下方插入一个空白行。认为这会很简单，但我搜索了很多论坛并尝试使用一些示例代码，但我无法让它正常工作。对于 VBA 的东西，我完全是个新手。我想我应该在这里发帖，然后去读一些 VBA 基础知识。

如果有人有任何好的培训资源，也请发布。

提前致谢!

编辑:在我的OP中，我忽略了任何包含“所有客户”值的行理想情况下都会突出显示并以粗体、增大的字体显示。

这些操作是旧的 Crystal Report 查看/格式化程序在提取报表时自动处理的操作。根据软件制造商的技术支持，在我们升级程序后，我了解到随着新版本程序的发布，这种类型的格式化功能已被删除。如果发行说明中对此进行了定义，我将不会执行升级。不管怎样，这就是我发现自己陷入这场宏观灾难的原因。

Answer 1

类似于此代码改编自 an article of mine here高效且避免循环

1. 它会在找到文本的地方加粗并增加字体大小(在整行中，正如 Tim 指出的那样，您应该指定是否仅指单元格)
2. 它在匹配项下方添加一个空白行

代码

Option Explicit

Const strText As String = "All Customers"

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 " & strText, "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

    'a) match string to entire cell, case insensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , False)

    'b) match string to entire cell, case sensitive
    'Set cel1 = rng1.Find(strText, , xlValues, xlWhole, xlByRows, , True)

    'c)match string to part of cell, case insensititive
     Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)

    'd)match string to part of cell, case sensititive
    ' Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , True)

    '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
        .Font.Size = 20
        .Offset(1, 0).EntireRow.Insert
        End With
    End If
    End If

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

End Sub