VBA：対象の列以外の列を一括削除したい

Question

実現したいこと

エクセルのシートが何枚かあり、
それぞれのシートから残したい対象の列名の列数を取得し、
(前提として全てのシートに対象の列名が必ず存在しています)
その対象列以外削除したい ということを実現したいです。

以下のコードで実行してみたところ、
エラーは出ないのですが対象の列以外がちゃんと削除されているシートと
削除されていないシートがあるため
原因をご教示いただけますでしょうか。

該当のソースコード

Sub test()

 
Dim i
Dim apple
Dim banana
Dim r As Long
Dim j As Long
Dim s As Variant
Dim f As Boolean
Dim LastClm As Long

'「Sheet1」の後ろのシートに処理をする
For i = Worksheets("Sheet1").Next.Index To Worksheets.Count
        Worksheets(i).Select
        
        
        '対象の列を変数に保持する
        '列名がりんごの列数取得
        apple= Worksheets(i).Rows(1).Find(What:="りんご", LookAt:=xlPart).Column
        
        '列名がばななの列取得
        banana = Worksheets(i).Rows(1).Find(What:="ばなな", LookAt:=xlPart).Column
        
        '削除したくない列の列番号
        s = Array(apple, banana)
       
        Application.ScreenUpdating = False


        '最終列を取得
        LastClm = Worksheets(i).Range("A1").End(xlToRight).Column
       
        '全列をループ
        For r = LastClm To 1 Step -1

            '配列ループ
            For j = 0 To UBound(s)
               
                '削除したくない列かどうかチェック
                If r = s(j) Then
                    f = True
                End If
                

            Next j

            '削除したい列だったら削除
            If f = False Then
                Worksheets(i).Columns(r).Delete
            Else
                'フラグをFalseに戻す
                f = False
            End If
           

        Next r

        Application.ScreenUpdating = True
   
    
Next i
End Sub

試したこと

ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

他の列が消えていないシートの共通点として、
対象の2列は前2列にくるのですが、そのうしろの列が空白の場合それ以降の列が消えていないという現象が起きています。
列名がない場合、列としてみなしてくれないのでしょうか。

Answer 1

Range("A1").End(xlToRight)

はctrl+→と同じ挙動なので空白セルで止まります。

Worksheets(i).Cells(1,Columns.Count).End(xlToLeft).Column

で一番右の列を取得するところですが、見たところ最後尾のデータに列名が空白になってしまってる可能性もありそうですね。ということなので

LastClm = Worksheets(i).UsedRange.columns.count

で使用している全セルの右端を取得してしまってもいいかも。

Deleteするってことは書式が消えてしまっても困らないということだと思うので列名が空欄になってたとしても(書式だけ設定されてる空白列だとしても)確実に消せますね

Comments

[pomiw0000]

コメントありがとうございます。
ぜひ参考にさせていただきます！

Answer 2

        '最終列を取得
        LastClm = Worksheets(i).Range("A1").End(xlToRight).Column

途中に空白セルがある場合は、上記のコードだと空白セルの前の列を取得します。
途中の空白セルを無視して最終列を取得するなら、下記のコードになります。

        '最終列を取得
        LastClm = Worksheets(i).Cells(1,Columns.Count).End(xlToLeft).Column

---

どうせ削除するときに最終列からループするので、
Findで探して配列に格納してなどと面倒なことをせずとも、
ループするときに1行目の値を確認すればすみます。
そうすれば下記のようなシンプルなコードになります。

Public Sub test()
    Dim i As Long
    For i = Worksheets("Sheet1").Next.Index To Worksheets.Count
        With Worksheets(i)
            Dim j As Long
            For j = .Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
                Select Case .Cells(1, j).Value
                Case "りんご", "ばなな"
                Case Else
                    .Columns(j).Delete
                End Select
            Next
        End With
    Next
End Sub

Comments

[pomiw0000]

ご丁寧にありがとうございます。
最終列の取得、配列をしようしなくてもできる点参考にさせていただきます！