0

以下のことができるマクロを探しています。

1) MECH_COMBINED シートの行が、COMPONENTS シートとまったく同じ情報で存在するかどうかを確認します。(MECH_COMBINED には約 7000 行、COMPONENTS には 20000 行あり、各シートには BI 同じ列名までの列があります)

2) MECH_COMBINED の行が存在する場合は、COMPONENTS シートの行全体を強調表示し、異なる行で 3 番目のシートを作成します (それが不可能な場合は、3 番目のシートに同じ強調表示された行がある可能性があります)。

これが可能なマクロであることを願っていますか？私が現在使用しているものは、実行速度が遅すぎて、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

前もって感謝します ：）

4

1 に答える 1

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
于 2013-05-29T16:28:28.563 に答える