【发布时间】:2015-07-02 21:42:10
【问题描述】:
我的目标:我需要能够从不同的工作簿中取出两个不同的工作表,并将它们组合成一个带有两个工作表的工作簿(已经完成)。其中一个工作表将来自旧数据并用作主列表,而另一个工作表将包含旧数据以及新数据(以及对旧数据的更改)。我需要能够摆脱主列表中已经存在的旧数据,但仍然检查旧数据是否有任何变化(这些信息将从新信息工作表中删除)。最终目标是有两个工作表:1 个包含旧信息(已经完成),1 个包含新信息和对新信息的任何更改(需要帮助)。
我现在拥有的:
子 DocumentInspector()
Dim RowCount As Integer
Dim Row As Integer
Dim Column As Integer
Dim ColumnCount As Integer
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim i As Integer
Dim count As Integer
Dim count2 As Integer
count2 = 0
i = 0
count = 0
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "F:\ \Document Inspector" ' change to suit
Set wbDst = Workbooks("DocumentInspector.xlsm")
strFilename = Dir(MyPath & "\*.xlsx", vbNormal)
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.count)
strFilename = Dir()
Loop
wbDst.Worksheets(2).Name = "Old Information"
wbDst.Worksheets(3).Name = "New Information"
'MUST CHANGE RANGES
RowCount = Sheets("New Information").UsedRange.Rows.count
ColumnCount = Sheets("New Information").UsedRange.Columns.count
'MUST CHANGE RANGE
For Each x In Sheets("Old Information").Range("A1:E10")
For Row = 2 To RowCount
For Column = 1 To ColumnCount
If x.Value = Sheets("New Information").Cells(Row, Column).Value Then
Sheets("New Information").Cells(Row, Column).Interior.Color = RGB(255, 255, 0)
End If
Next Column
Next Row
Next
For Row = 2 To RowCount
For Column = 1 To ColumnCount
If Sheets("New Information").Cells(Row, Column).Interior.Color = RGB(255, 255, 0) Then
Sheets("New Information").Cells(Row, Column).Interior.Color = xlNone
count = count + 1
Else
Sheets("New Information").Cells(Row, Column).Interior.Color = RGB(255, 255, 0)
count2 = count2 + 1
End If
Next Column
If count = ColumnCount Then
Sheets("New Information").Rows(Row).EntireRow.Interior.Color = xlNone
Sheets("New Information").Rows(Row).EntireRow.Delete
Row = Row - 1
ElseIf count2 = ColumnCount Then
Sheets("New Information").Rows(Row).EntireRow.Interior.Color = xlNone
Sheets("New Information").Rows(Row).EntireRow.Delete
End If
count2 = 0
count = 0
Next Row
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
结束子
【问题讨论】: