楼主
liuguansky |
Q:如何比较两个工作簿对应工作表对应项目的变动信息？
一个工作簿代表一个月的数据，每个工作簿里有多个企业工作表，每一个企业工作表又有多个项目，现在的问题是如何返回两个工作簿对应工作表的对应项目的变化情况。
A:用如下代码可以实现：
- Sub justtest()
- Dim arr1(1 To 3) As New dictionary, arr2(1 To 3) As New dictionary
- Dim i&, j&, k%, pa$, str1$, arrt
- pa = ThisWorkbook.Path
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- On Error Resume Next
- Workbooks.Open pa & "\11.xls"
- With Workbooks(1)
- For i = 1 To 4
- With .Sheets(i)
- str1 = .Name
- arr = .Cells(2, 1).Resize(.Cells(Rows.Count, 1).End(3).Row - 1, 3)
- For j = 2 To UBound(arr, 1)
- For k = 1 To 3
- If arr(j, k) <> "" Then arr1(k)(arr(j, k)) = ""
- Next k, j
- With Workbooks(2).Worksheets(str1)
- arr = .Cells(2, 1).Resize(.Cells(Rows.Count, 1).End(3).Row - 1, 3)
- For j = 2 To UBound(arr, 1)
- For k = 1 To 3
- If arr(j, k) <> "" Then arr2(k)(arr(j, k)) = ""
- Next k, j
- End With
- End With
- If i = 1 Then
- .Sheets("结果返回").Delete
- .Sheets.Add after:=.Worksheets(.Sheets.Count)
- .ActiveSheet.Name = "结果返回"
- Else: .Sheets("结果返回").Activate
- End If
- With .ActiveSheet
- j = i * 3 - 2
- .Cells(1, j) = str1 & "本月有上月没有的项目"
- .Cells(2, j).Resize(1, 3) = Application.Index(arr, 1)
- For k = 1 To 3
- arrt = st(arr1(k), arr2(k))
- .Cells(3, j + k - 1).Resize(UBound(arrt) + 1, 1) = Application.Transpose(arrt)
- Next k
- End With
- Next i
- End With
- Workbooks(2).Close False
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
- Function st(ar, ad)
- Dim k
- For Each k In ad.Keys
- If ar.Exists(k) Then ar.Remove k
- Next k
- st = ar.Keys
- End Function
具体示例文件如下：
|
跟着睡神学E功