在所選單元格的每個單元格中突出顯示唯一的單詞列表 - Excel VBA

Question

描述

我覺得答案很簡單，但我就是想不通。 我正在開發一個代碼，使用用戶窗體輸入和字符串拆分來突出顯示所選內容的每個單元格中的指定單詞列表。 這是對我在公共領域其他地方找到的代碼的修改。 原代碼沒有使用Userform，也沒有使用Module中的大寫函數。 在我添加代碼的 Userform 部分之前，它與我為使代碼不區分大寫而進行的調整完美配合。 據我所知，問題似乎來自模塊而不是用戶窗體。 重復出現的問題是它只會使用所提供列表中的最后一個詞。 下面提供了使用的代碼及其應用示例。 任何幫助將不勝感激！

(例 1) 變更數據：

（例 2）空白用戶表單：

（例 3）填寫的用戶表單：

(Ex. 4) 數據改變：

*注意：當前未實現用戶窗體中的滾動條。

模塊：Mod2HighlightString

    'Updateby Extendoffice
    Application.ScreenUpdating = False
    Dim Rng As Range '-variable to hold each cells value in the selection
    Dim cFnd As String '-variable that holds the user input from the userform
    Dim xTmp As String '-variable for temporary holds on parts of string (I think)
    Dim i As Long '-variable for holding color index value
    Dim j As Variant '-variable for testing a split array
    Dim k As Integer '-variable for a loop
    Dim x As Long '-variable for a loop
    Dim m As Long '-variable for holding number of times a word is in a cell
    Dim y As Long '-variable for holding len function
    Dim Color As String '-variable to hold value provided for desired font color
    Dim xFNum As Integer '-variable for a loop
    Dim xArrFnd As Variant '-variable holds array of words to search for provided from userform
    Dim xStr As String '-variable that temp holds a single string from the array of strings
    Mod2User.Show
    Color = CStr(Mod2User.ComboBox1.Value)
    If Color = "Red" Then i = 3
    If Color = "Green" Then i = 4
    If Color = "Blue" Then i = 5
    If Color = "Cyan" Then i = 8
    If Color = "Pink" Then i = 7
    If Color = "Orange" Then i = 46
    cFnd = CStr(Mod2User.TextBox1.Value) 'InputBox("Please enter the text, separate them by comma:")
    Debug.Print Color; Chr(10); cFnd
    If Len(cFnd) < 1 Then Exit Sub
    'xArrFnd - holds array of words to search for
    xArrFnd = Split(cFnd, Chr(10))
'    j = UBound(xArrFnd)
    
    For Each Rng In Selection
        With Rng
            'rng.value will supply the cells content within the selection
'            Debug.Print .Value
            For xFNum = 0 To UBound(xArrFnd)
                'xStr - Temp holds a single string from the array of strings
                xStr = xArrFnd(xFNum)
                y = Len(xStr)
                m = UBound(Split(UCase(Rng.Value), UCase(xStr)))
                
                j = Split(UCase(Rng.Value), UCase(xStr))
                
                Debug.Print "word "; xFNum; " is "; xStr
                Debug.Print "y:"; y; " m: "; m
                Debug.Print "Split: ["; UCase(Rng.Value); "], using: ["; UCase(xStr); "]"
                
                For k = 0 To UBound(j)
                    Debug.Print "Result: "; j(k)
                Next k
                
                If m > 0 Then
                    xTmp = ""
                    For x = 0 To m - 1
                        xTmp = xTmp & Split(UCase(Rng.Value), UCase(xStr))(x)
                        Debug.Print UCase(xStr)
                        Debug.Print UCase(Rng.Value)
                        
'                        Debug.Print "at x ="; x; "first xtmp = "; xTmp
                        .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = i
                        xTmp = xTmp & xStr
                    Next
                End If
            Next xFNum
        End With
    Next Rng
    Unload Mod2User
    Application.ScreenUpdating = True
End Sub

用戶形式：Mod2User

Private m_Cancelled As Boolean

Public Property Get Cancelled() As Variant
    Cancelled = m_Cancelled
End Property

Private Sub ComboBox1_Change()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub ScrollBar1_Change()

End Sub

Private Sub TextBox1_Change()
    
End Sub

Private Sub UserForm_Click()

End Sub



Private Sub CommandButton1_Click()
    Hide
End Sub

Private Sub UserForm_Initialize()

    With Mod2User
      .Width = Application.Width * 0.293
      .Height = Application.Height * 0.35
    End With
    
    
    With ComboBox1
        .Clear
        .AddItem "Red"
        .AddItem "Green"
        .AddItem "Blue"
        .AddItem "Cyan"
        .AddItem "Pink"
        .AddItem "Orange"
    End With
    
    TextBox1.MultiLine = True
'    TextBox1.ScrollBars =

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer _
                                        , CloseMode As Integer)
    
    ' Prevent the form being unloaded
    If CloseMode = vbFormControlMenu Then Cancel = True
    
    ' Hide the Userform and set cancelled to true
    Hide
    m_Cancelled = True
    
End Sub

Function GetComboBox1() As String
    GetComboBox1 = CStr(ComboBox1.Value)
End Function

調試.打印結果

Blue
the
downey
fierce
word  0  is the

y: 4  m:  0 
Split: [THE CAT GOES TO THE MOON ON A FINE SUNDAY AFTERNOON IF THE BAKER IS IN THE ], using: [THE
]
Result: THE CAT GOES TO THE MOON ON A FINE SUNDAY AFTERNOON IF THE BAKER IS IN THE 
word  1  is downey

y: 7  m:  0 
Split: [THE CAT GOES TO THE MOON ON A FINE SUNDAY AFTERNOON IF THE BAKER IS IN THE ], using: [DOWNEY
]
Result: THE CAT GOES TO THE MOON ON A FINE SUNDAY AFTERNOON IF THE BAKER IS IN THE 
word  2  is fierce
y: 6  m:  0 
Split: [THE CAT GOES TO THE MOON ON A FINE SUNDAY AFTERNOON IF THE BAKER IS IN THE ], using: [FIERCE]
Result: THE CAT GOES TO THE MOON ON A FINE SUNDAY AFTERNOON IF THE BAKER IS IN THE 
word  0  is the

y: 4  m:  0 
Split: [ROBERT DOWNEY JUNIOR GOES TO MEMPHIS TO PLAY FOOTBALL], using: [THE
]
Result: ROBERT DOWNEY JUNIOR GOES TO MEMPHIS TO PLAY FOOTBALL
word  1  is downey

y: 7  m:  0 
Split: [ROBERT DOWNEY JUNIOR GOES TO MEMPHIS TO PLAY FOOTBALL], using: [DOWNEY
]
Result: ROBERT DOWNEY JUNIOR GOES TO MEMPHIS TO PLAY FOOTBALL
word  2  is fierce
y: 6  m:  0 
Split: [ROBERT DOWNEY JUNIOR GOES TO MEMPHIS TO PLAY FOOTBALL], using: [FIERCE]
Result: ROBERT DOWNEY JUNIOR GOES TO MEMPHIS TO PLAY FOOTBALL
word  0  is the

y: 4  m:  0 
Split: [THE OOMPA LOOPAS WERE FIERCE FIGHTERS], using: [THE
]
Result: THE OOMPA LOOPAS WERE FIERCE FIGHTERS
word  1  is downey

y: 7  m:  0 
Split: [THE OOMPA LOOPAS WERE FIERCE FIGHTERS], using: [DOWNEY
]
Result: THE OOMPA LOOPAS WERE FIERCE FIGHTERS
word  2  is fierce
y: 6  m:  1 
Split: [THE OOMPA LOOPAS WERE FIERCE FIGHTERS], using: [FIERCE]
Result: THE OOMPA LOOPAS WERE 
Result:  FIGHTERS
FIERCE
THE OOMPA LOOPAS WERE FIERCE FIGHTERS
word  0  is the

y: 4  m:  0 
Split: [THE DOG HAS A A FIERCE PERSONALITY AND ONLY GOES NUMBER 2 ON THE NEIGHBORS YARD], using: [THE
]
Result: THE DOG HAS A A FIERCE PERSONALITY AND ONLY GOES NUMBER 2 ON THE NEIGHBORS YARD
word  1  is downey

y: 7  m:  0 
Split: [THE DOG HAS A A FIERCE PERSONALITY AND ONLY GOES NUMBER 2 ON THE NEIGHBORS YARD], using: [DOWNEY
]
Result: THE DOG HAS A A FIERCE PERSONALITY AND ONLY GOES NUMBER 2 ON THE NEIGHBORS YARD
word  2  is fierce
y: 6  m:  1 
Split: [THE DOG HAS A A FIERCE PERSONALITY AND ONLY GOES NUMBER 2 ON THE NEIGHBORS YARD], using: [FIERCE]
Result: THE DOG HAS A A 
Result:  PERSONALITY AND ONLY GOES NUMBER 2 ON THE NEIGHBORS YARD
FIERCE
THE DOG HAS A A FIERCE PERSONALITY AND ONLY GOES NUMBER 2 ON THE NEIGHBORS YARD
word  0  is the

y: 4  m:  0 
Split: [CATS SECRETLY LOVE DOGS BUT CANT OWN UP TO IT], using: [THE
]
Result: CATS SECRETLY LOVE DOGS BUT CANT OWN UP TO IT
word  1  is downey

y: 7  m:  0 
Split: [CATS SECRETLY LOVE DOGS BUT CANT OWN UP TO IT], using: [DOWNEY
]
Result: CATS SECRETLY LOVE DOGS BUT CANT OWN UP TO IT
word  2  is fierce
y: 6  m:  0 
Split: [CATS SECRETLY LOVE DOGS BUT CANT OWN UP TO IT], using: [FIERCE]
Result: CATS SECRETLY LOVE DOGS BUT CANT OWN UP TO IT
word  0  is the

y: 4  m:  0 
Split: [CHUCK NORRIS IS A PERSON LIKE YOU AND I], using: [THE
]
Result: CHUCK NORRIS IS A PERSON LIKE YOU AND I
word  1  is downey

y: 7  m:  0 
Split: [CHUCK NORRIS IS A PERSON LIKE YOU AND I], using: [DOWNEY
]
Result: CHUCK NORRIS IS A PERSON LIKE YOU AND I
word  2  is fierce
y: 6  m:  0 
Split: [CHUCK NORRIS IS A PERSON LIKE YOU AND I], using: [FIERCE]
Result: CHUCK NORRIS IS A PERSON LIKE YOU AND I
word  0  is the

y: 4  m:  0 
Split: [HARLM SHAKE WAS A VIBE], using: [THE
]
Result: HARLM SHAKE WAS A VIBE
word  1  is downey

y: 7  m:  0 
Split: [HARLM SHAKE WAS A VIBE], using: [DOWNEY
]
Result: HARLM SHAKE WAS A VIBE
word  2  is fierce
y: 6  m:  0 
Split: [HARLM SHAKE WAS A VIBE], using: [FIERCE]
Result: HARLM SHAKE WAS A VIBE
word  0  is the

y: 4  m:  0 
Split: [WHEN I GO TO FRANCE I WILL EAT SNAIL], using: [THE
]
Result: WHEN I GO TO FRANCE I WILL EAT SNAIL
word  1  is downey

y: 7  m:  0 
Split: [WHEN I GO TO FRANCE I WILL EAT SNAIL], using: [DOWNEY
]
Result: WHEN I GO TO FRANCE I WILL EAT SNAIL
word  2  is fierce
y: 6  m:  0 
Split: [WHEN I GO TO FRANCE I WILL EAT SNAIL], using: [FIERCE]
Result: WHEN I GO TO FRANCE I WILL EAT SNAIL

Answer 1

在文本框中它是 vbcrlf 而不是 chr(10)

xArrFnd = Split(cFnd, Chr(10))

應該

xArrFnd = Split(cFnd, vbCrLf)

您的拆分有效，但每個單詞仍然包含一個 chr(13)

Answer 2

或者使用正則表達式

Option Explicit

Sub demo()

    Dim dictColor As Object, regex As Object, m, xArrFnd
    Dim rng As Range
    Dim n As Long, i As Long, j As Long, s As String, c As Range
    Dim iColor As Long
    
    Set dictColor = CreateObject("Scripting.Dictionary")
    With dictColor
        .Add "Red", 3
        .Add "Green", 4
        .Add "Blue", 5
        .Add "Cyan", 8
        .Add "Pink", 7
        .Add "Orange", 46
    End With
    
    'Mod2User.Show
    ' color
    iColor = dictColor(CStr(Mod2User.ComboBox1.Value))
    If iColor = 0 Then
        MsgBox "Unknown colour, using RED", vbExclamation
        iColor = 3
    End If
    
    'strings
    s = CStr(Mod2User.TextBox1.Value)
    If Len(s) < 1 Then
        MsgBox "No string", vbExclamation
        Exit Sub
     End If
     
    'xArrFnd - holds array of words to search for
    xArrFnd = Split(s, vbCrLf) 'ASCII 0D0A
    
    Set regex = CreateObject("vbscript.regexp")
    With regex
      .Global = True
      .MultiLine = False
      .IgnoreCase = True
      .Pattern = "(" & Join(xArrFnd, "|") & ")"
      Debug.Print .Pattern
    End With
    
    For Each rng In Selection.Cells
        If regex.test(rng.Value) Then
            Set m = regex.Execute(rng.Value)
            For n = 0 To m.Count - 1
                i = m(n).FirstIndex
                j = Len(m(n))
                rng.Characters(i + 1, Length:=j).Font.ColorIndex = iColor
            Next
        End If
    Next
    Unload Mod2User
    
End Sub