[[20170307114243]]　『タイトル行が2行ある場合の検索＆削除』（パピコ）　ページの最後に飛ぶ

『タイトル行が2行ある場合の検索＆削除』（パピコ）

以下のような表が2シートから最終列まであります。

(表の構成)
・1,2行目は空白
・3,4行目はタイトル行
「空」←空白行
・5,6行目以降データ

■処理前

   A 　B  C  D  E      F     G    H　   I　    J    K　  L　　　…
1 
2
3  No. 空 空 空 空　　 名称  動作 備考  設定値 空   発行 配布 　…
4  a 　b  c  d  ab-cd  空    空   空    min 　 max  ○   ×　 　…
5　
6

　----***----

やりたいことは、

1．3行目から残したいタイトル行を検索する。（No.,名称,動作,設定値）
2．4行目から残したいタイトル行を検索する。（a,b,c,d,ab-cd,min,max）
3．それ以外の列を削除する
4．2シートから最後のシートまで繰り返し処理

■処理後

   A 　B  C  D  E      F     G   　 H　    I　    …
1 
2
3  No. 空 空 空 空　　 名称  動作   設定値 空     …
4  a 　b  c  d  ab-cd  空    空     min 　 max    …
5　
6

　----***----

このようにしたいのですが、
VBAコードを教えていただけないでしょうか(>_<)
(ファイルを開くなどのコードは不要)

よろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

見事なまでの丸投げですね。ここまでは作れた、とか、こうやれば、とか、この命令なら、とか、ご自身で調べられる部分がいっぱいあるでしょうに…。

 Sub test()
    Dim i As Long
    Dim j As Long

    Application.ScreenUpdating = False

    For i = 2 To Sheets.Count
        With Sheets(i)
            For j = .Range("A3").CurrentRegion.EntireColumn.Count To 1 Step -1
                If Not "|No.|名称|動作|設定値|" Like "*|" & .Cells(3, j).Value & "|*" Then
                    If Not "|a|b|c|d|ab-cd|min|max|" Like "*|" & .Cells(4, j).Value & "|*" Then
                        .Columns(j).Delete
                    End If
                End If
            Next j
        End With
    Next i

    Application.ScreenUpdating = True
 End Sub
（???） 2017/03/07(火) 13:07

 ちょっと変化球ですが。
 空白の１行目を、こっそりと作業域に使っています。

 Sub Sample()
    Dim x As Long
    Dim col As Long

    Application.ScreenUpdating = False

    For x = 2 To Worksheets.Count
        With Worksheets(x)
            col = WorksheetFunction.Max(.Cells(3, Columns.Count).End(xlToLeft).Column, .Cells(4, Columns.Count).End(xlToLeft).Column)
            With .Range("A1").Resize(, col)
                .Formula = _
                    "=IF(OR(ISNUMBER(MATCH(A3,{""No."",""設定値"",""名称"",""動作""},0)),ISNUMBER(MATCH(A4,{""a"",""b"",""c"",""d"",""ab-cd"",""min"",""max""},0))),"""",1)"
                On Error Resume Next
                .SpecialCells(xlCellTypeFormulas, xlNumbers).EntireColumn.Delete
                On Error GoTo 0
            End With
            .Rows(1).ClearContents
        End With
    Next

 End Sub

（β） 2017/03/07(火) 14:16

（???）様（β）様

丸投げの質問にも関わらず、ご回答いただきありがとうございます。
（β）様の回答が一番理想に近かったので
こちらのコードを参考にさせていただきます。

ありがとうございました。
（パピコ） 2017/03/07(火) 14:39

コメント返信：

[ 一覧(最新更新順) ]

[[20170307114243]] 『タイトル行が2行ある場合の検索＆削除』（パピコ） ページの最後に飛ぶ

[[20170307114243]]　『タイトル行が2行ある場合の検索＆削除』（パピコ）　ページの最後に飛ぶ