突出显示选定单元格的每个单元格中的唯一单词列表- Excel VBA

2nc8po8w 于 2023-01-14 发布在其他

关注(0)|答案(2)|浏览(192)

- 说明**

我觉得答案很简单，但是我就是想不出来。我正在开发一个代码，使用用户表单输入和字符串拆分来突出显示 * 选择 * 的每个单元格中指定单词的列表。这是我在公共域的其他地方找到的代码的修改。原始代码在模块中没有使用用户表单或大写函数。在我添加代码的用户表单部分之前，它与我所做的调整完美地工作，使代码非大写敏感。问题似乎来自模块，而不是用户表单，因为我可以告诉。再次出现的问题是，它只会使用最后一个单词在一个列表中提供。使用的代码及其应用程序的例子如下所示。任何帮助将不胜感激!
(Ex. 1）需要修改的数据：

(Ex. 2）空白用户表单：

(Ex. 3）填写的用户表单：

(Ex. 4）数据变更：

注意：用户表单中的滚动条目前尚未实现。
- 模块：模块2突出显示字符串**

'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

- 用户表单：Mod2用户**

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

excel

来源：https://stackoverflow.com/questions/75084994/highlighting-unique-list-of-words-in-each-cell-of-a-selection-of-cells-excel-v

2条答案

按热度按时间

u91tlkcl1#

在文本框中它是vbcrlf而不是chr（10）

xArrFnd = Split(cFnd, Chr(10))

应该是

xArrFnd = Split(cFnd, vbCrLf)

您的拆分可以工作，但每个单词仍包含一个字符（13）

赞(0）回复(0）举报 2023-01-14

ni65a41a2#

或者使用正则表达式

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

赞(0）回复(0）举报 2023-01-14

我来回答

突出显示选定单元格的每个单元格中的唯一单词列表- Excel VBA

2条答案

相关问题

热门标签

最新问答