|
现在的表里面存在一个问题,就是
定义的变量应该是定义错了,For Each j In Split(Mid(d1(i), 2), ",")这一句报类型不匹配。
还有就是最后的标红部分,目前是只要2个表的内容不一致就标红,能否让"人员变动"里面,如果是空的,就不变色,由内容且不一致的再标红。
Sub test()
Dim d, d1, arr, brr, crr, i, j, ii, n
Dim Split(), Mid()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
arr = Sheets("人员变动").[a3].CurrentRegion
brr = Sheets("人员信息").[a1].CurrentRegion
ReDim crr(1 To 3 * UBound(arr), 1 To UBound(arr, 2))
For i = 2 To UBound(brr) '原始信息表
d(brr(i, 1)) = i '编号和行对应
Next
For i = 2 To UBound(arr) '人员变动表
ii = d(arr(i, 1))
n = n + 1
If ii > 0 Then '变动表和人员信息表中都有
For j = 1 To UBound(arr, 2)
crr(n, j) = brr(ii, j) '先取人员信息表中的信息
crr(n + 1, j) = arr(i, j) '再取变动表中的信息
If crr(n, j) <> crr(n + 1, j) Then d1(n) = d1(n) & "," & j '原始信息和变动信息不同的列
Next
Else '变动表中有,人员信息表中无,表示新增人员
crr(n, 1) = "新增人员,无原始数据"
For j = 1 To UBound(arr, 2)
crr(n + 1, j) = arr(i, j)
Next
End If
n = n + 2
Next
With Sheets("审核结果")
.Range("a2").Resize(10000, 50).Clear
.Range("a2").Resize(n).NumberFormatLocal = "@" '编号调成文本格式
.Range("a2").Resize(n, UBound(crr, 2)) = crr
For i = 1 To n
If InStr(d1(i), ",") > 0 Then
For Each j In Split(Mid(d1(i), 2), ",")
.Cells(i + 1, Val(j)).Resize(2).Interior.Color = vbRed '原始信息和变动信息不同的列标红
Next
End If
Next
.Activate
End With
End Sub
|
|