在电子表格的一列中如何突出显示重复单词,忽略文本大小写和标点符号。

huangapple go评论170阅读模式
英文:

How to highlight duplicate word in a column in spreadsheet, ignoring text case and Punctuation

问题

我正在在Excel上进行一个项目,但由于它是来自多个不同人的集体数据,我想在编译后找到任何重复的单词并将其突出显示。我找到了一个网站,它解释了如何使用宏来突出显示单元格中的重复单词,而且不区分大小写,还有一些叫做宏的东西?抱歉,我还是新手,但是否可以检测一列中的重复内容,而且不区分大小写,也不考虑标点符号如“.”或“/”?

我刚学会如何使用宏的功能。编辑代码仍然让我感到困惑。

英文:

I'm working on a project in excel, but since its a collective data from multiple different person, i want to find any duplicate word after compile it and highlight it. I found a site where it explain about how to Highlight duplicate words in a cell ignoring text case with thing called macro? sorry im new to this, but can it be possible to detect duplicate in one column, ignoring text case and punctuation like "." or "/"?

i just learn the function of macro. Editing the code still confusing.

答案1

得分: 0

使用Scripting.Dictionary来实现。

  1. Sub How_to_highlight_duplicate_word_in_a_column_in_spreadsheet_ignoring_text_case_and_Punctuation()
  2. Dim cln As Range, ws As Worksheet, c As Range, cv As String, cCollection As New VBA.Collection, key, colr As Long
  3. Dim cDict As New Scripting.Dictionary
  4. 'Dim cDict As Object
  5. 'Set cDict = CreateObject("Scripting.Dictionary")
  6. Set ws = ActiveSheet
  7. Set cln = ws.UsedRange.Columns(3) 'for test
  8. For Each c In cln.Cells
  9. cv = c.Value
  10. If cv <> vbNullString Then
  11. cv = VBA.StrConv(cv, vbLowerCase)
  12. RemovePunctuation cv
  13. If cDict.Exists(cv) Then
  14. Set cCollection = cDict(cv)
  15. cCollection.Add c
  16. Else
  17. Set cCollection = Nothing
  18. cCollection.Add c
  19. cDict.Add cv, cCollection
  20. End If
  21. End If
  22. Next c
  23. For Each key In cDict.Keys
  24. Set cCollection = cDict(key)
  25. If cCollection.Count > 1 Then
  26. colr = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
  27. For Each c In cCollection
  28. ComplementaryColors c, colr
  29. ' With c.Interior
  30. ' ' .Pattern = xlSolid
  31. ' ' .PatternColorIndex = xlAutomatic
  32. ' .Color = colr
  33. ' ' .TintAndShade = 0
  34. ' ' .PatternTintAndShade = 0
  35. ' End With
  36. Next c
  37. End If
  38. Next key
  39. End Sub
  40. Function RemovePunctuation(str As String) As String
  41. Dim regex As Object
  42. Set regex = CreateObject("VBScript.RegExp")
  43. With regex
  44. .Pattern = "[^A-Z0-9 ]"
  45. '.Pattern = "[^\w\s]"
  46. .IgnoreCase = True
  47. .Global = True
  48. str = .Replace(str, "")
  49. End With
  50. RemovePunctuation = str
  51. End Function
  52. Sub ComplementaryColors(cell As Range, color As Long)
  53. With cell.Font
  54. .color = color
  55. ' .color = RGB(255 - color Mod 256, 255 - (color \ 256) Mod 256, 255 - color \ 65536)
  56. End With
  57. With cell.Interior
  58. .color = RGB(255 - color Mod 256, 255 - (color \ 256) Mod 256, 255 - color \ 65536)
  59. End With
  60. End Sub

(Note: The code provided is in VBA and contains comments in English, which have not been translated.)

英文:

Use Scripting.Dictionary to implement.

  1. Sub How_to_highlight_duplicate_word_in_a_column_in_spreadsheet_ignoring_text_case_and_Punctuation()
  2. Dim cln As Range, ws As Worksheet, c As Range, cv As String, cCollection As New VBA.Collection, key, colr As Long
  3. Dim cDict As New Scripting.Dictionary
  4. 'Dim cDict As Object
  5. 'Set cDict = CreateObject("Scripting.Dictionary")
  6. Set ws = ActiveSheet
  7. Set cln = ws.UsedRange.Columns(3) 'for test
  8. For Each c In cln.Cells
  9. cv = c.Value
  10. If cv <> vbNullString Then
  11. cv = VBA.StrConv(cv, vbLowerCase)
  12. RemovePunctuation cv
  13. If cDict.Exists(cv) Then
  14. Set cCollection = cDict(cv)
  15. cCollection.Add c
  16. Else
  17. Set cCollection = Nothing
  18. cCollection.Add c
  19. cDict.Add cv, cCollection
  20. End If
  21. End If
  22. Next c
  23. For Each key In cDict.Keys
  24. Set cCollection = cDict(key)
  25. If cCollection.Count > 1 Then
  26. colr = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
  27. For Each c In cCollection
  28. ComplementaryColors c, colr
  29. ' With c.Interior
  30. ' ' .Pattern = xlSolid
  31. ' ' .PatternColorIndex = xlAutomatic
  32. ' .Color = colr
  33. ' ' .TintAndShade = 0
  34. ' ' .PatternTintAndShade = 0
  35. ' End With
  36. Next c
  37. End If
  38. Next key
  39. End Sub
  40. Function RemovePunctuation(str As String) As String
  41. Dim regex As Object
  42. Set regex = CreateObject("VBScript.RegExp")
  43. With regex
  44. .Pattern = "[^A-Z0-9 ]"
  45. '.Pattern = "[^\w\s]"
  46. .IgnoreCase = True
  47. .Global = True
  48. str = .Replace(str, "")
  49. End With
  50. RemovePunctuation = str
  51. End Function
  52. Sub ComplementaryColors(cell As Range, color As Long)
  53. With cell.Font
  54. .color = color
  55. ' .color = RGB(255 - color Mod 256, 255 - (color \ 256) Mod 256, 255 - color \ 65536)
  56. End With
  57. With cell.Interior
  58. .color = RGB(255 - color Mod 256, 255 - (color \ 256) Mod 256, 255 - color \ 65536)
  59. End With
  60. End Sub

huangapple
  • 本文由 发表于 2023年5月26日 08:35:13
  • 转载请务必保留本文链接:https://go.coder-hub.com/76336977.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定