程序代码:
Sub clk()
On Error Resume Next
Dim max_row As Long
With Sheet3 '对表3操作
max_row = Sheet3.[aa:aa].Find("*", , xlValues, , , xlPrevious).row '获取aa列最大行数
If max_row = 0 Then 'aa列第一行无数据,简单处理
max_row = max_row + 1
End If
If .Cells(max_row + 1, 1) = "" Then '如果该行没有数据,则不处理,直接退出程序
Exit Sub
End If
.Cells(max_row + 1, "aa") = Sheet1.Cells(1, "o") '对aa,ab两列处理
.Cells(max_row + 1, "ab") = .Cells(max_row + 1, "a")
Dim d As Object
Dim k As Long
Set d = CreateObject("scripting.dictionary") '创建一个字典,储存sheet2的数据,用于判断
For k = 1 To 8 'sheet2数据存入字典d
d(CInt(Sheet2.Cells(2, k + 1))) = Sheet2.Cells(2, k + 1)
Next
Dim col As Long
For col = 2 To 24 '处理一行的数据,标记颜色
.Cells(max_row + 1, col + 27) = .Cells(max_row + 1, col)
If d.exists(CInt(.Cells(max_row + 1, col + 27))) Then
.Cells(max_row + 1, col + 27).Interior.ColorIndex = 13
End If
Next
End With
End Sub