2017-05-03 72 views
0

目標:比較兩個Excel表格和拉重複數據

  1. 搜索&比較兩個字段列E(表2)〜E欄(表1)從表2 返回重複值來表3
  2. 顯示和突出顯示重複的表1和2
  3. 複製重複從表2項 光值,然後添加到表3

如果列E(表2)=列E(表1),然後從(表2)複製行並添加到表3

我想比較工作簿中的兩個Excel表。我想在表2和1之間找到重複的值,並在兩張表上突出顯示這些值。我知道這是一個匹配或vlookup函數,但增加的層是我想複製這些值只從表2到表3進行視覺比較。我試圖創建一個宏,但這沒有幫助,我正在嘗試編輯這個過程;

Sub rowContent() 
    Dim ws1 As Worksheet 
    Dim ws2 As Worksheet 
    Dim i As Long, j As Long 
    Dim isMatch As Boolean 
    Dim newSheetPos As Integer 

Set ws1 = ActiveWorkbook.Sheets("Sheet1") 
Set ws2 = ActiveWorkbook.Sheets("Sheet2") 

'Initial position of first element in sheet2 
newSheetPos = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row 

For i = 1 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row 
    isMatch = False 
    For j = 1 To ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row 
     If ws1.Cells(i, 1).Value = ws1.Cells(j, 2).Value Then 
      ws1.Cells(j, 2).EntireRow.Copy ws2.Cells(newSheetPos, 1) 
      isMatch = True 
      newSheetPos = newSheetPos + 1 
     End If 
    Next j 
    If isMatch = False Then newSheetPos = newSheetPos + 1 
Next i 
End Sub 

爲我的情況工作。任何幫助將不勝感激,因爲我不是Excel大師。

+0

代碼不是很有用嗎?它是否運行,但不能按預期工作?它會拋出一個錯誤(如果是這樣,什麼錯誤/在哪裏)?另外,當兩張紙上的「E1」都一樣時,它是否重複?或者Sheet1,Col.E中的值可以在Sheet2列E中的任何位置? – BruceWayne

+0

可能的重複[如何刪除兩個Excel表格之間的重複快速vba](http://stackoverflow.com/questions/13665305/how-do-i-delete-duplicates-between-two-excel-sheets-quickly- vba) – Masoud

+0

對不起,我認爲是寫了那句話錯了。列出的腳本沒有錯。我嘗試創建的宏有問題。列出的腳本是我目前正在嘗試重新設計以適應我的具體情況。 該腳本比較一張紙上的兩列並將數據提取到另一張紙上。這不是我想要做的。我正在嘗試爲另一張紙上的一張紙上的信息執行VLOOKUP以查找重複值,然後從該行中將該數據提取到第三張紙上 – Neil

回答

0

你可以試試這樣的事情...

Sub CopyDuplicates() 
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 
Dim lr1 As Long, lr2 As Long, lc1 As Long, lc2 As Long, r As Long 
Dim rng As Range, cell As Range 
Application.ScreenUpdating = False 

Set ws1 = Sheets("Sheet1") 
Set ws2 = Sheets("Sheet2") 
Set ws3 = Sheets("Sheet3") 

ws3.Cells.Clear 
lr2 = ws2.UsedRange.Rows.Count 
lc1 = ws1.UsedRange.Columns.Count 
lc2 = ws2.UsedRange.Columns.Count 

ws1.UsedRange.Interior.ColorIndex = xlNone 
ws2.UsedRange.Interior.ColorIndex = xlNone 

Set rng = ws2.Range("E1:E" & lr2) 
For Each cell In rng 
    If Application.CountIf(ws1.Range("E:E"), cell.Value) > 0 Then 
     r = Application.Match(cell.Value, ws1.Range("E:E"), 0) 
     ws1.Range(ws1.Cells(r, 1), ws1.Cells(r, lc1)).Interior.Color = vbRed 
     ws2.Range(ws2.Cells(r, 1), ws2.Cells(r, lc2)).Interior.Color = vbRed 
     cell.EntireRow.Copy ws3.Range("A" & Rows.Count).End(3)(2) 
    End If 
Next cell 
ws3.Rows(1).Delete 
Application.ScreenUpdating = True 
End Sub 

上面的代碼假定你有三個工作表Sheet1表,Sheet2的工作表Sheet 3,並在工作簿中。

該代碼將刪除Sheet1和Sheet2上任何現有的單元格內部顏色,然後突出顯示含有紅色重複項的行。

如果您已對這些圖紙應用了一些顏色格式,最好使用條件格式來突出顯示具有重複項的行,而不是通過VBA代碼對它們進行着色。

+0

謝謝你現在就試試這個 – Neil