エクセル マクロ 定型ごと抜き出す

質問

エクセル2010を使っています。

画像の様なデータがあり、8行が1括りになった表があります。
【Sheet4】　（A列～CL列まで）

その中でM列に　優良　もしくは　欠陥　と入力されています。
これは、一つの表内で混じる事はありません。

その優良と入力された表だけを　【Sheet５】に抜き出したいです。

※　ちなみに、現状で5万行ほどありますので、出来れば負担の掛からない形で抜き出したいです。

詳しい方、教えて頂けませんか？
よろしくお願い致します。

回答No.2

tom04 · ベストアンサー

こんにちは！

VBAになりますが一例です。

標準モジュールに↓コードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim lastRow As Long
Application.ScreenUpdating = False
With Worksheets("Sheet4")
.Rows(1).Insert
.Range("M1") = "ダミー"
lastRow = .Cells(Rows.Count, "M").End(xlUp).Row
Range(.Cells(1, "A"), .Cells(lastRow, "CL")).AutoFilter field:=13, Criteria1:="優良"
If .Cells(Rows.Count, "M").End(xlUp).Row > 1 Then '←念のため
Range(.Cells(2, "A"), .Cells(lastRow, "CL")).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Sheet5").Range("A1")
End If
.AutoFilterMode = False
.Rows(1).Delete
End With
Application.ScreenUpdating = True
MsgBox "処理完了"
End Sub

こんなんではどうでしょうか？m(_ _)m

お礼

回答ありがとうございます。

一発で解決しました、やっぱりマクロが早いですね、感謝します。

ありがとうございました！！

回答No.1

misatoanna

負担をかけないのでしたら、マクロ処理かと思います。

[開発]タブの[Visual Basic]から開くウィンドウの[挿入]-[標準モジュール]から表示される白紙部分に以下を記述し、そのウィンドウを閉じます。

Sub Test()
　Dim r, cnt, uni
　r = 1
　Do While Cells(r, "M").Value <> ""
　　If Cells(r, "M").Value = "優良" Then
　　　cnt = cnt + 1
　　　Select Case cnt
　　　　Case Is = 1
　　　　　Set uni = Range(Rows(r), Rows(r + 7))
　　　　Case Else
　　　　　Set uni = Union(uni, Range(Rows(r), Rows(r + 7)))
　　　End Select
　　End If
　　r = r + 8
　Loop
　uni.Copy Sheets("Sheet5").Range("A1")
End Sub

[開発]タブの[Visual Basic]から開くウィンドウの[挿入]-[標準モジュール]から表示される白紙部分に

Sheet4を表示した状態で、[開発]タブの[マクロ]から上記マクロを実行します。

お礼

回答ありがとうございます。

一発で解決しました、やっぱりマクロが早いですね、感謝します。

ありがとうございました！！