|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
以下是我写的程序,目的是检查行项目是否有更新,但是结果显示所有行项目都有更新,现实中的出货业务不可能隔一天就有这么天翻地覆的变化。请帮忙看看问题出在哪里了?如果能够实现在有变化点的位置标注颜色就更好了,但是感觉数组好像没法实现对单元格标注颜色呢,请教各位老师,谢谢!
Sub db()
Dim table1, table2 As Workbook
Dim sht1, sht2 As Worksheet
Dim i&, j&, d, e, Arr, Brr, x$, y$, z, Crr()
Set table1 = ThisWorkbook
Set table2 = Workbooks.Open(table1.Path & "\出货计划old.xls")
Set sht1 = table1.Worksheets("出货计划")
Set sht2 = table2.Worksheets("出货计划")
Set e = CreateObject("Scripting.Dictionary")
Arr = sht1.[a1].CurrentRegion
Brr = sht2.[a1].CurrentRegion
For i = 2 To UBound(Brr)
x = Brr(i, 9)
For j = 14 To UBound(Brr, 2)
y = Brr(1, j)
If e.exists(x) = False Then Set e(x) = CreateObject("Scripting.Dictionary")
e(x)(y) = Brr(i, j)
Next
Next
table2.Close False
ReDim Crr(1 To UBound(Arr))
For i = 2 To UBound(Arr)
x = Arr(i, 9)
If e.exists(x) Then
For j = 14 To UBound(Arr, 2)
y = Arr(1, j)
If e(x).exists(y) Then
z = Arr(i, j)
If e(x)(y) = z Then
Crr(i) = "无更新"
Else
Crr(i) = "有更新"
End If
Else
Crr(i) = "有更新"
End If
Next
Else
Crr(i) = "有更新"
End If
Next
sht1.Range("DU2:DU434") = WorksheetFunction.Transpose(Crr)
End Sub
|
|