2015-07-01 17 views
0

我的目標是:我需要能夠從不同的工作簿中取出兩個不同的工作表,並將它們合併到一個工作表中幷包含兩個工作表(已完成)。其中一個工作表將來自舊數據並用作主清單,而另一個工作表將包含舊數據以及新數據(以及對舊數據的更改)。我需要能夠清除主列表中已有的舊數據,但仍要檢查舊數據是否有任何更改(信息將從新信息工作表中刪除)。最終目標是製作兩個工作表:1包含舊信息(已完成),1包含新信息和對新信息的任何更改(需要幫助)。Excel VBA - 創建僅包含新信息和變更的新電子表格

我有什麼現在:

子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 

末次

回答

0

試試這個,
我與公式做,你可以做同樣的VBA太動態。

它可以是一個解決方案,但可能比這更好。

參考下面的圖片。

它是簡單的匹配和連接。 IMAGE

+0

這將工作如果兩個工作表上的行應該是相同的,那麼行數會有所不同。行可以在工作表上的任何位置,我需要能夠刪除它們,如果它們是舊的並突出顯示新信息。 – CennerB

+0

如果數據位於工作表中的任何位置,並且需要過濾並保持需要,則可以執行此操作。 – Punith

0

什麼,我需要能夠做例子:

工作表1 「舊信息」

ABCD

EFGH

工作表2 「新信息」

ABCD

EFJH

運行的代碼....

工作表1 「舊信息」

ABCD

EFGH

工作表2 「新信息」

EFJH(帶J突出顯示)