0

したがって、それぞれに 6 列のデータがある 6 セットのデータを含むワークシートがあります。6 つのデータセットのそれぞれで、セット番号が一致するものを取り出したいだけです。例えば、

001 ------ 003 ------ 002 ------ 003 ------ 003 ------ 003 ------
002 ------ 004 ------ 003 ------ 006 ------ 004 ------ 005 ------
003 ------ 005 ------ 006 ------ 007 ------ 009 ------ 013 ------

これらは 6 セットのデータです。この並べ替えマクロでは、各セットの最初の列のみが重要です。ここでは、各セットが「003-----」という行を共有しています。他と一致しない行を削除するマクロを書きたいです。これを整理して、003-----だけを残すマクロはありますか?

「if Rng (A1) > Rng.Offset(,6) AND Rng > Rng.Offset(,12)... その後 (関連する行を削除)」というループ マクロを作成しています。

ただし、このためには、利用可能なすべての可能性をカバーする必要があります。私が見逃している別のより明白なアプローチはありますか?

ありがとう、

4

1 に答える 1

0

このマクロは、シートSheet1内の同一の行をすべてループして出力します。Output

Sub DeleteNonMatch()
    Dim i As Double
    Dim NotFound As Boolean
    Dim Inp As Worksheet, Out As Worksheet
    Dim r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range

    'Defines the sheets
    Set Inp = ActiveWorkbook.Sheets("Sheet1") 'Sheet with original dat
    Set Out = ActiveWorkbook.Sheets("Output") 'Output sheet

    'Defines the searchable ranges input sheet
    Set r2 = Inp.Range(Inp.Range("G2").Address & ":" & Inp.Cells(Rows.Count, 7).End(xlUp).Address)
    Set r3 = Inp.Range(Inp.Range("M2").Address & ":" & Inp.Cells(Rows.Count, 13).End(xlUp).Address)
    Set r4 = Inp.Range(Inp.Range("S2").Address & ":" & Inp.Cells(Rows.Count, 19).End(xlUp).Address)
    Set r5 = Inp.Range(Inp.Range("Y2").Address & ":" & Inp.Cells(Rows.Count, 25).End(xlUp).Address)
    Set r6 = Inp.Range(Inp.Range("AE2").Address & ":" & Inp.Cells(Rows.Count, 31).End(xlUp).Address)

    'Sets headers in output sheet
    With Out.Range("A1")
        .Offset(0, 0).Value = Inp.Range("A1").Value
        .Offset(0, 1).Value = Inp.Range("G1").Value
        .Offset(0, 2).Value = Inp.Range("M1").Value
        .Offset(0, 3).Value = Inp.Range("S1").Value
        .Offset(0, 4).Value = Inp.Range("Y1").Value
        .Offset(0, 5).Value = Inp.Range("AE1").Value
    End With

    'Prints identical groups to output sheet
    For i = 2 To Inp.Cells(Rows.Count, 1).End(xlUp).Row Step 1
        NotFound = False

        If r2.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True
        If r3.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True
        If r4.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True
        If r5.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True
        If r6.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True

        If NotFound = False Then
            With Out.Cells(Out.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
                .Offset(0, 0).Value = Inp.Cells(i, 1).Value
                .Offset(0, 1).Value = Inp.Cells(i, 1).Value
                .Offset(0, 2).Value = Inp.Cells(i, 1).Value
                .Offset(0, 3).Value = Inp.Cells(i, 1).Value
                .Offset(0, 4).Value = Inp.Cells(i, 1).Value
                .Offset(0, 5).Value = Inp.Cells(i, 1).Value
            End With
        End If
    Next i
End Sub
于 2013-11-12T21:44:15.870 に答える