Question

我有一个尚无法使用的代码。应该打开一个输入窗口，您可以在其中输入文本。然后它将打开一个窗口，您可以在其中输入范围。在两次输入之后，应搜索整个工作簿，并将部分文本所在的整个单元格标记为粗体。如果该单元格包含的文本多于您要查找的文本，则应将其标记为粗体。单元格中的示例为文本： “亚洲出口地区”

如果仅在输入窗口中输入“出口区域”，则包含“亚洲出口区域”的单元格应标记为完全粗体。

到目前为止，这是我的代码：

Sub Zelle_Fett_Wenn_best_Inhalt_Input_Box()
Dim Filtertext As String
Dim ws As Worksheet
Dim aRange As Range
On Error Resume Next
  Set aRange = Application.InputBox(prompt:="Enter range", Type:=8)
  If aRange Is Nothing Then
    MsgBox "Operation Cancelled"
  Else
    aRange.Select
  End If

Filtertext = InputBox("Enter Text")
For Each ws In Worksheets
ws.Select
x = ActiveSheet.UsedRange.Rows.Count
Rows.Select
If Cells.Value Like Filtertext Then
    Selection.Font.Bold = True
Else
    Selection.Font.Bold = False
End If
Next ws
End Sub

也许有人会很乐意纠正它，以便它起作用。

非常感谢和欢呼汤姆

Answer 1

因此，根据我的评论，我建议您不要使用.Select或UsedRange。而是动态获取上次使用的行和列。此外，您在Like运算符中缺少通配符，并且希望遍历整个Range对象。

接下来，我想说您可以跳过迭代并使用条件格式或使用ReplaceFormat，例如：

Sub Test()

Dim lr As Long, lc As Long, rng As Range, ws As Worksheet, FilterText As String

FilterText = InputBox("Enter Text")
If FilterText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets

    'Get last used row and column
    lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    'Set your range object
    Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(lr, lc))

    'Set your ReplaceFormat
    With Application.ReplaceFormat
        .Clear
        .Font.Bold = True
    End With

    'Replace formatting to cells with right criteria
    rng.Font.Bold = False
    rng.Replace What:="*" & FilterText & "*", Replacement:="", SearchFormat:=False, ReplaceFormat:=True

Next ws

End Sub

我遗漏了aRange，因为我发现您甚至从未使用过它。

用匹配的部分字符标记单元格为粗体

1 个答案: