固排检查（问题已解决，正解在3楼）

jx928867128 · 发表于 2024-4-4 19:55

本帖最后由 jx928867128 于 2024-4-5 09:25 编辑

蓝桥玄霜 · 发表于 2024-4-4 21:23

检查的例子：

jx928867128 · 发表于 2024-4-4 21:43

本帖最后由 jx928867128 于 2024-4-5 06:49 编辑

蓝桥玄霜发表于 2024-4-4 21:23
检查的例子：

谢谢版主帮忙，问题已解决，祝您生活愉快

Sub lqxs()
Dim Myr&, Myc%, Arr, i%, j%, rl
Application.ScreenUpdating = False
Sheet1.Activate
Cells.Font.ColorIndex = 1
Cells.Interior.ColorIndex = xlNone
Sheet4.Cells.Interior.ColorIndex = xlNone
Myr = Cells(Rows.Count, 1).End(xlUp).Row
Myc = [iv4].End(xlToLeft).Column
Arr = Sheet1.Range("a1").Resize(Myr, Myc)
brr = Sheet4.Range("a1").Resize(Myr, Myc)
For i = 5 To UBound(Arr)
For j = 2 To UBound(Arr, 2)
      If Arr(i, j) <> "" And brr(i, j) <> "" Then
         If Arr(i, j) = brr(i, j) Then
            Cells(i, j).Font.ColorIndex = 14
         Else
            Cells(i, j).Interior.ColorIndex = 3
            Sheet4.Cells(i, j).Interior.ColorIndex = 3
            Set rl = Rows(i).Find(brr(i, j), , , 1)
            If Not rl Is Nothing Then
               Cells(i, rl.Column).Font.ColorIndex = 44
            End If
         End If
   End If
Next
Next
Application.ScreenUpdating = True
End Sub

		自动登录	找回密码
密码			免费注册

[求助] 固排检查（问题已解决，正解在3楼）