Question

我正在使用在extendoffice.com上找到的经过修改的VBA宏来更改单元格中指定的输入字符串。宏效果很好；我突出显示要分析的单元格，并要求输入。然后将指定的字符串涂成蓝色字母并加粗。我希望可以对此进行一些更改，以便宏可以找到多个字符串，而不必为每个新字符串单独运行。

尝试：对于i for UserList // UserList =单元格A1，字符串之间用逗号分隔

Sub HighlightStrings()
'Updateby Extendoffice 20160704
Application.ScreenUpdating = False
Dim Rng As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
cFnd = InputBox("Enter the text string to highlight")
y = Len(cFnd)
For Each Rng In Selection
  With Rng
    m = UBound(Split(Rng.Value, cFnd))
    If m > 0 Then
      xTmp = ""
      For x = 0 To m - 1
        xTmp = xTmp & Split(Rng.Value, cFnd)(x)
        .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
        .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.Bold = True
        xTmp = xTmp & cFnd
      Next
    End If
  End With
Next Rng
Application.ScreenUpdating = True
End Sub

我想将“血栓”，“中风”，“抗凝疗法”等字加粗为蓝色；为此，该宏需要运行3次。我希望能够创建一个字符串列表，并使宏在列表中运行，所以我只需要运行一次。

我几乎没有编码知识，感谢您的帮助。

Answer 1

您可以创建集合并遍历它。抱歉，这有点混乱，但是我现在有点忙，无法按照我的意愿清理代码，但是它可以工作；输入框将一直弹出，直到它保持空白，或者单击“取消”：

Sub HighlightStrings()
    'Updateby Extendoffice 20160704
    Application.ScreenUpdating = False
    Dim Rng As Range
    Dim cFnd As String
    Dim xTmp As String
    Dim x As Long
    Dim m As Long
    Dim y As Long
    Dim myCol As New Collection

    Do
        ib = InputBox("Enter the text string to highlight")
        If ib <> vbNullString Then myCol.Add ib
    Loop While ib <> vbNullString

    For Each mc In myCol
        cFnd = mc
        y = Len(cFnd)
        For Each Rng In Selection
            With Rng
            m = UBound(Split(Rng.Value, cFnd))
                If m > 0 Then
                    xTmp = ""
                    For x = 0 To m - 1
                        xTmp = xTmp & Split(Rng.Value, cFnd)(x)
                        .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
                        .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.Bold = True
                        xTmp = xTmp & cFnd
                    Next
                End If
            End With
        Next Rng
    Next mc

    Application.ScreenUpdating = True
End Sub

Answer 2

我们可以对您的sub进行非常小的更改，以允许其接受参数，然后在循环中调用它：

Sub MAIN()
    Dim MyList As String, arr, a
    MyList = Application.InputBox(Prompt:="give me comma-separated text strings", Type:=2)
    arr = Split(MyList, ",")
    For Each a In arr
        Call HighlightStrings(a)
    Next a
End Sub

Sub HighlightStrings(cFnd As Variant)
        'Updateby Extendoffice 20160704
        Application.ScreenUpdating = False
        Dim Rng As Range
        Dim xTmp As String
        Dim x As Long
        Dim m As Long
        Dim y As Long

        y = Len(cFnd)
        For Each Rng In Selection
          With Rng
            m = UBound(Split(Rng.Value, cFnd))
            If m > 0 Then
              xTmp = ""
              For x = 0 To m - 1
                xTmp = xTmp & Split(Rng.Value, cFnd)(x)
                .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
                .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.Bold = True
                xTmp = xTmp & cFnd
              Next
            End If
          End With
        Next Rng
        Application.ScreenUpdating = True
End Sub

使用Excel VBA更改多个文本字符串

2 个答案: