[[20141208130003]]　『任意の複数シートの処理』（MARU）　ページの最後に飛ぶ

『任意の複数シートの処理』（MARU）

 以下の3つの処理を一つにしたい。
 シートAとBの処理は、同じ（F1000～AJ1000までの間で、0またはXの値の列を削除）
 シートCは、（E1000～AI1000までの間で、0またはXの値の列を削除）

 'シートAの処理 
 Sub Sample()
    Dim c As Range
    Dim r As Range

    For Each c In Sheets("A").Range("F1000").CurrentRegion.Rows(1).Cells
        If c.Value Like 0 Or c.Value Like "X" Then
            If r Is Nothing Then
                Set r = c
            Else
                Set r = Union(r, c)
            End If
        End If
    Next

    'Oまたは、Xの列を削除
    If Not r Is Nothing Then r.EntireColumn.Delete

 End Sub

 'シートBの処理 
 Sub Sample()
    Dim c As Range
    Dim r As Range

    For Each c In Sheets("B").Range("F1000").CurrentRegion.Rows(1).Cells
        If c.Value Like 0 Or c.Value Like "X" Then
            If r Is Nothing Then
                Set r = c
            Else
                Set r = Union(r, c)
            End If
        End If
    Next

    'Oまたは、Xの列を削除
    If Not r Is Nothing Then r.EntireColumn.Delete

 End Sub
 'シートCの処理 
 Sub Sample()
    Dim c As Range
    Dim r As Range

    For Each c In Sheets("C").Range("E1000").CurrentRegion.Rows(1).Cells
        If c.Value Like 0 Or c.Value Like "X" Then
            If r Is Nothing Then
                Set r = c
            Else
                Set r = Union(r, c)
            End If
        End If
    Next

    'Oまたは、Xの列を削除
    If Not r Is Nothing Then r.EntireColumn.Delete

 End Sub

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

 Sub Sample()
    Dim c As Range
    Dim r As Range
    Dim ic As Long

    If ActiveSheet.Name <> "C" Then
        ic = 1
    End If

    For Each c In ActiveSheet.Range("E1000").Offset(0, ic).CurrentRegion.Rows(1).Cells
        If c.Value Like 0 Or c.Value Like "X" Then
            If r Is Nothing Then
                Set r = c
            Else
                Set r = Union(r, c)
            End If
        End If
    Next

    'Oまたは、Xの列を削除
    If Not r Is Nothing Then r.EntireColumn.Delete
 End Sub
（???） 2014/12/08(月) 13:29

 ありがとうございます。
 確認してみましたところ、　
 シートCのみ処理され、A,Bは何も処理されません。

（MARU） 2014/12/08(月) 14:57

シートを切り替えつつ、3回実行する、というのは元と変わっていないのですが。
1つのマクロを実行するだけで3つのシートを対象としたい、ということでしょうか？
（???） 2014/12/08(月) 15:37

 横から失礼します。
 ???さんから素晴らしいコードが提示されることはわかっているのですが、 勉強を兼ねて
 自分なりに考えてみました。

 Sub Sample1()

    Dim ws As Worksheet
    Dim c As Long, i As Long

    For Each ws In Sheets(Array("A", "B", "C"))
       If ws.Name <> "C" Then
          c = 6
       Else
          c = 5
       End If
       For i = c + 30 To c Step -1
          If ws.Cells(1000, i) Like 0 Or ws.Cells(1000, i) Like "X" Then ws.Columns(i).Delete
       Next
    Next

 End Sub
（se_9） 2014/12/08(月) 15:47

見つけた列を削除してしまうと、列番号が変わってしまうから、Unionで連結しておいて、一気に削除。
でも、後ろから消せば面倒な事をしなくて済むじゃん、というのがse_9さんの例ですね。

私の提案も、Sheets(Array("A", "B", "C"))として、順番にシートを指定することだったので、
一気削除がお好みであれば、この部分を応用して頂けたら、と思います。
（???） 2014/12/08(月) 16:09

  ???さん　se_9さん　
 丁寧な説明をありがとうございます。
 提示いただいた内容にて同時(一気)削除ができました。 
 大変勉強になりました。
 ありがとうございました。　
　　　　
（MARU） 2014/12/08(月) 23:13

コメント返信：

[ 一覧(最新更新順) ]

[[20141208130003]] 『任意の複数シートの処理』（MARU） ページの最後に飛ぶ

[[20141208130003]]　『任意の複数シートの処理』（MARU）　ページの最後に飛ぶ