[办公]
依次查询H列内容和J列内容对比，如果含有8位数相同，那么单元格背景变成黄色
Excel VBA 编程：依次查询H列内容和J列内容对比，如果含有8位数相同，那么单元格背景变成黄色。
- Sub HighlightMatching8Digits()
- Dim ws As Worksheet
- Dim lastRow As Long
- Dim i As Long
- Dim hValue As String, jValue As String
- Dim hDigits As Collection, jDigits As Collection
- Dim digit As Variant
-
- ' 设置当前工作表
- Set ws = ActiveSheet
-
- ' 获取最后一行数据
- lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
-
- ' 循环处理每一行
- For i = 1 To lastRow
- ' 重置背景色
- ws.Cells(i, "H").Interior.ColorIndex = xlNone
- ws.Cells(i, "J").Interior.ColorIndex = xlNone
-
- ' 获取单元格值
- hValue = CStr(ws.Cells(i, "H").Value)
- jValue = CStr(ws.Cells(i, "J").Value)
-
- ' 提取H列中的所有8位数字
- Set hDigits = Get8DigitNumbers(hValue)
-
- ' 提取J列中的所有8位数字
- Set jDigits = Get8DigitNumbers(jValue)
-
- ' 检查是否有相同的8位数字
- If HasCommonItem(hDigits, jDigits) Then
- ' 如果有相同的8位数字，设置背景色为黄色
- ws.Cells(i, "H").Interior.Color = vbYellow
- ws.Cells(i, "J").Interior.Color = vbYellow
- End If
- Next i
-
- MsgBox "处理完成！", vbInformation
- End Sub
- ' 从字符串中提取所有8位数字
- Function Get8DigitNumbers(inputStr As String) As Collection
- Dim regex As Object
- Dim matches As Object
- Dim match As Object
- Dim result As New Collection
-
- Set regex = CreateObject("VBScript.RegExp")
- With regex
- .Pattern = "\b\d{8}\b" ' 匹配8位数字
- .Global = True ' 全局匹配
- .IgnoreCase = True ' 不区分大小写
- End With
-
- Set matches = regex.Execute(inputStr)
-
- For Each match In matches
- result.Add match.Value
- Next match
-
- Set Get8DigitNumbers = result
- End Function
- ' 检查两个集合是否有共同元素
- Function HasCommonItem(col1 As Collection, col2 As Collection) As Boolean
- Dim item1 As Variant
- Dim item2 As Variant
-
- For Each item1 In col1
- For Each item2 In col2
- If item1 = item2 Then
- HasCommonItem = True
- Exit Function
- End If
- Next item2
- Next item1
-
- HasCommonItem = False
- End Function
|
|
|
|
|
|
|
|
|
