0

複数のシートを含む1つのExcelファイルがあります。2つのシート（1）TotalListと（2）cListを25列以上で比較する必要があります。これらの2つのシートの列は同じです。

cListでは開始行は3です。TotalListでは開始行は5です。

ここで、cListのE＆F列をTotalList E＆F列と比較する必要があります。見つからない場合は、TotalListシートの最後に行全体を追加し、黄色で強調表示します。

Public Function compare()  
    Dim LoopRang As Range  
    Dim FoundRang As Range  
    Dim ColNam  
    Dim TotRows As Long  

    LeaData = "Shhet2"
    ConsolData = "Sheet1"

    TotRows = Worksheets(LeaData).Range("D65536").End(xlUp).Row  
    TotRows1 = Worksheets(ConsolData).Range("D65536").End(xlUp).Row  
    'TotRows = ThisWorkbook.Sheets(LeaData).UsedRange.Rows.Count  
    ColNam = "$F$3:$F" & TotRows  
    ColNam1 = "$F$5:$F" & TotRows1  
    For Each LoopRang In Sheets(LeaData).Range(ColNam)  
        Set FoundRang = Sheets(ConsolData).Range(ColNam1).Find(LoopRang, lookat:=xlWhole)  
        For Each FoundRang In Sheets(ConsolData).Range(ColNam1)  
            If FoundRang & FoundRang.Offset(0, -1) <> LoopRang & LoopRang.Offset(0, -1) Then    
                TotRows = Worksheets(ConsolData).Range("D65536").End(xlUp).Row  
                ThisWorkbook.Worksheets(LeaData).Rows(LoopRang.Row).Copy ThisWorkbook.Worksheets(ConsolData).Rows(TotRows + 1)  
                ThisWorkbook.Worksheets(ConsolData).Rows(TotRows + 1).Interior.Color = vbYellow  
                GoTo NextLine  
            End If  
        Next FoundRang  
NextLine:  
    Next LoopRang  

End Function

VBAコードを手伝ってください。前もって感謝します...

4

1 に答える 1

0

まず、一般的なコーディングのヒントをいくつか紹介します。

  1. Option Explicit を ON に設定します。これは、[ツール] > [オプション] > [エディター] (タブ) > [変数宣言が必要] で行います。ここで、変数を使用する前にすべての変数を宣言する必要があります。
  2. 宣言するときは、常に変数の型を宣言してください。何を訴えるべきか、または異なるタイプを取ることができるかどうかが不明な場合 (お勧めできません!!) を使用してVariableください。
  3. すべての変数に標準の命名規則を使用します。私のものは、で始まる文字列と、 などの範囲strの doubleです。また、変数に意味のある名前を付けてください!dblrstrTestdblProfitrOriginal
  4. Excel スプレッドシートに意味のある名前またはキャプションを付けます (キャプションは Excel で表示されるもので、名前は VBA で直接参照できる名前です)。ユーザーはキャプションを簡単に変更できますが、VBA ウィンドウを開いた場合にのみ名前を変更できるため、キャプションの使用は避け、代わりに名前を参照してください。

わかりましたので、開始点としてコードを使用して 2 つのテーブルを比較する方法を次に示します。

Option Explicit

Public Function Compare()

        Dim rOriginal As Range          'row records in the lookup sheet (cList = Sheet2)
        Dim rFind As Range              'row record in the target sheet (TotalList = Sheet1)
        Dim rTableOriginal As Range     'row records in the lookup sheet (cList = Sheet2)
        Dim rTableFind As Range         'row record in the target sheet (TotalList = Sheet1)
        Dim shOriginal As Worksheet
        Dim shFind As Worksheet
        Dim booFound As Boolean

        'Initiate all used objects and variables
        Set shOriginal = ThisWorkbook.Sheets("Sheet2")
        Set shFind = ThisWorkbook.Sheets("Sheet1")
        Set rTableOriginal = shOriginal.Range(shOriginal.Rows(3), shOriginal.Rows(shOriginal.Rows.Count).End(xlUp))
        Set rTableFind = shFind.Range(shFind.Rows(5), shFind.Rows(shFind.Rows.Count).End(xlUp))
        booFound = False

        For Each rOriginal In rTableOriginal.Rows
            booFound = False
            For Each rFind In rTableFind.Rows
                'Check if the E and F column contain the same information
                If rOriginal.Cells(1, 5) = rFind.Cells(1, 5) And rOriginal.Cells(1, 6) = rFind.Cells(1, 6) Then
                    'The record is found so we can search for the next one
                    booFound = True
                    GoTo FindNextOriginal 'Alternatively use Exit For
                End If
            Next rFind

            'In case the code is extended I always use a boolean and an If statement to make sure we cannot
            'by accident end up in this copy-paste-apply_yellow part!!
            If Not booFound Then
                'If not found then copy form the Original sheet ...
                rOriginal.Copy
                '... paste on the Find sheet and apply the Yellow interior color
                With rTableFind.Rows(rTableFind.Rows.Count + 1)
                    .PasteSpecial
                    .Interior.Color = vbYellow
                End With
                'Extend the range so we add another record at the bottom again
                Set rTableFind = shFind.Range(rTableFind, rTableFind.Rows(rTableFind.Rows.Count + 1))
            End If

FindNextOriginal:
        Next rOriginal

End Function
于 2012-11-13T13:33:01.857 に答える