2013-05-29 33 views
0

我要尋找一個宏可以做以下對比:宏全行的兩片

1)查看是否在組件表中確切同一信息存在於自MECH_COMBINED表任何行。 (MECH_COMBINED中有大約7000行,COMPONENTS中有大約20000個,每個表都有列上至BI相同列名的列)

2)如果MECH_COMBINED中的行存在,則突出顯示COMPONENTS表中的整行並創建第三個紙與不同行(如果多數民衆贊成不可能的,那麼第三張可能具有相同的高亮行

我希望這是一個可能的宏?我現在使用的一個運行方式過於緩慢,最終凍結的Excel。

Sub Test() 
Application.ScreenUpdating = False 
Dim bottomA1 As Integer bottomA1 = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row Dim c As Range 
Dim bottomA2 As Integer bottomA2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row Dim x As Integer For Each c In Sheets("Sheet2").Range("A1:A" & bottomA2) 
For x = bottomA1 To 2 Step -1 If Cells(x, 1) = c Then Cells(x, 1).EntireRow.Interior.Color = 255 End If Next x Next c Application.ScreenUpdating = True 
End Sub 

在此先感謝:)

+0

及以下:http://verticalhorizo​​ns.in/macro-to-compare-two-excel-worksheets-and-copy-different-rows-to-new-worksheet/ – Shivster

+0

請把你的代碼這個問題在哪裏可以被格式化爲可讀性。 –

回答

0
The highlight differs between Excel Versions. Record a macro that highlights then modify 
and insert it. Here is a rough macro hopely it is what you want. 

Sub macro1() 
n = 0 
For i = 1 To Sheets("MECH_COMBINED").Cells(Rows.Count, "A").End(xlUp).Row 
    For j = 1 To Sheets("COMPONENTS").Cells(Rows.Count, "A").End(xlUp).Row 
     For k = 1 To 51 'A to BI 
      If Sheets("MECH_COMBINED").Cells(i, k) = Sheets("COMPONENTS").Cells(j, k) Then 
       If notequal = 0 Then 
        If k = 51 Then 

         'Highlight Row in Sheets("COMPONENTS") 

         'copy complete row 
         n = n + 1 
         For m = 1 To 51 
          Sheets("Sheet3").Cells(n, m) = Sheets("MECH_COMBINED").Cells(i, m) 
         Next 

         'highlight complete row in Sheets("Sheet3") 

        End If 
       End If 
      Else 
       notequal = 1 
      End If 
     Next k 
     notequal = 0 
    Next j 
Next i 
End Sub 
+0

我試過,但我得到了以下錯誤消息「運行時錯誤'9':下標超出範圍」 – Shivster

+0

它也崩潰excel爲我 – Shivster