複数の表から条件に合致するデータを抽出するマクロ

1779 ワード
マクロ エクセル マクロ テキストリンク

複数のQA表の未完了QAを確認できるように、抽出マクロを作成してみた。

QA表はこんなイメージ

QA未完了一覧はこんなイメージ


マクロはこんな感じ

Sub 未完了QA抽出()

Dim qaBookAddress As String
Dim qaBooksRow As Integer, qasRow As Integer, qasExtractRow As Integer, i As Integer, j As Integer
Dim qa As Workbook

'一覧をクリアする
ThisWorkbook.Sheets(1).Range(Cells(3, 1), Cells(1000, 9)).ClearContents

'開始位置の設定
qaBooksRow = 2
qasExtractRow = 3

For i = qaBooksRow To ThisWorkbook.Sheets("config").Cells(Rows.Count, 2).End(xlUp).Row

    qaBookAddress = ThisWorkbook.Sheets("config").Cells(i, 2)

    Set qa = Workbooks.Open(Filename:=qaBookAddress)

    qasRow = 2

    For j = qasRow To qa.Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row

        If qa.Sheets(1).Cells(j, 6).Value <> "完了" Then

            qa.Sheets(1).Range(Cells(j, 1), Cells(j, 9)).Copy
            ThisWorkbook.Sheets(1).Cells(qasExtractRow, 1).PasteSpecial Paste:=xlPasteValues

            ThisWorkbook.Sheets(1).Cells(qasExtractRow, 10) = qaBookAddress

            qasExtractRow = qasExtractRow + 1

        End If

    Next j

    Application.DisplayAlerts = False
    qa.Close
    Application.DisplayAlerts = True

Next i

End Sub