[[20210112094639]]　『空白セルをスキップして実行したい』（ぬぬぬ）　ページの最後に飛ぶ

『空白セルをスキップして実行したい』（ぬぬぬ）

VBAについてはネットで調べながら作成しはじめた初心者になります。
以前、こちらの掲示板で別の内容で質問させて頂いたコードについて、
別の内容で困ったことがありましたので相談させてください。
シートをコピーしてシート名を変更する下記内容のコードを作成し、実行する事ができました。
しかし、下記コードでは空白でない間は繰り返すと書いているので当然ですが、6行目のどこかの列に空白があった際に、そこで処理が終わってしまいます。
これを空白であってもスキップして実行したいと考えています。
If ws.Cells(6, intColumns) <> "" Then
End If
をDo While ws.Cells(6, intColumns) <> ""の後に記載すればいいのかなと思ったのですが、上手くいきませんでした。どの様に記載すればよろしいでしょうか。
また、空白であってもスキップするという内容を記載すると、どうやって、ループを抜けばせばいいのだろうかと思っています。

何卒、宜しくお願い致します。

Private Sub CommandButton1_Click()

Dim intColumns As Integer
Dim flg As Boolean
Dim addWs As Worksheet
Dim chkWs As Worksheet
Dim ws As Worksheet
Set ws = Worksheets("一覧")

'シート名は5列目から入力されるので5で初期化
intColumns = 5

'シート名の入力がある限り処理を続けます
Do While ws.Cells(6, intColumns) <> ""

   flg = True
   'シートの存在チェック
   For Each chkWs In Worksheets
       If chkWs.Name = ws.Cells(6, intColumns) Then
           flg = False
           Exit For
       End If
   Next chkWs
   '同じシート名がない場合のみ追加
   If flg Then
       '最後尾にシートを追加します
       ThisWorkbook.Sheets("計算書フォーマット").Copy After:=Sheets(Sheets.Count)
       Set addWs = ActiveSheet
       '追加されたシートに名前を付けます
       addWs.Name = ws.Cells(6, intColumns)
   End If
   intColumns = intColumns + 1
Loop
ws.Activate
End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

[[20210108101032]]　『シートをコピーして名前の変更を自動で行いたい。』（ぬぬぬ）
話としては↑の続きですね。

前トピックに書こうかとおもいましたが、ループ処理はDo～Loop以外にも方法があります。

たとえば、最終【列番号】をしらべてFor～Nextステートメントで処理する方法、

    Sub さんぷる2()
        Dim 列 As Long
        For 列 = 5 To Cells(6, Columns.Count).End(xlToLeft).Column
            If Cells(6, 列).Value <> "" Then
                MsgBox Cells(6, 列).Value
            End If
        Next
    End Sub

また、For Each ～ Nextステートメントで、特定のセル範囲のなかから【１つずつ取り出して】処理する方法

    Sub さんぷる()
        Dim MyRNG As Range
        For Each MyRNG In Range("E6", Cells(6, Columns.Count).End(xlToLeft))
            If MyRNG.Value <> "" Then
                MsgBox MyRNG.Value
            End If
        Next
    End Sub

等があります。
これらを使う場合は、シート名に0文字の文字列を充てることができないので、上記のようにセルの値が空白だったら処理しないなど、なんらかの措置をしておいたほうがよいです。
（または、エラートラップしてシート名が変更できなかったときに警告するなど）

（もこな２） 2021/01/12(火) 10:22

まず、ロジックから考えましょう。
空白をスキップするなら、処理はする範囲はどこまでなのかを決める必要があります。
例えば、E列からZ列までなら、そこまでループする必要がありますよね。
現行は空白までとなっており流動的なので、DoLoopですが、上記ならばForNextになります。
（tkit） 2021/01/12(火) 10:27

もこな2様
前回から引き続き、回答ありがとうございます。
質問内容が変わったため、トピックを分けた方が良いのかなと思い、分けさせて頂きました。
For～Nextステートメント
For Each ～ Nextステートメント
を教えていただきありがとうございます。
ネットで調べた際に、For～Nextは範囲が決まっている際に使用する云々とあり、今回のコードではセル範囲を流動的に変えたかったため、Do While～Loopを使用していました。
さんぷるで頂いたコードを検索や実際に実行したりして、理解しようとし仕組みはわかったと思います。
しかし、自分が作成したコードにどのように落とし込めば、頂いたコードの様に空白をスキップできるようになるのかまではできませんでした。大変申し訳ございませんが、ご教授頂けないでしょうか。

（ぬぬぬ） 2021/01/12(火) 11:10

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

空白をスキップするなら、処理はする範囲はどこまでなのかを決める必要があります。この考え方ができておりませんでした。ご指摘ありがとうございます。
処理する範囲を決めるのに、もこな2様にご教授頂いたような、最終【列番号】を取得する方法があるんだなと思いました。
DoLoopとForNextの違い等、理解を深めていこうともいます。
ありがとうございます。

（ぬぬぬ） 2021/01/12(火) 11:17

う～ん。わからない部分がわかりません。

    Sub さんぷる2()
        Dim 列 As Long
        For 列 = 5 To Cells(6, Columns.Count).End(xlToLeft).Column
            If Cells(6, 列).Value <> "" Then
                ■１　Cells(6, 列).Value シートが存在するか調べる
                ■２　↑が存在しなかったら末尾にコピー挿入する
                ■２　↑で追加したシートの名前をCells(6, 列).Value　に変える
            End If
        Next
    End Sub
 '-------------------------------------------------------------------------
    Sub さんぷる3()
        Dim MyRNG As Range
        For Each MyRNG In Range("E6", Cells(6, Columns.Count).End(xlToLeft))
            If MyRNG.Value <> "" Then
                ■１　MyRNG.Value シートが存在するか調べる
                ■２　↑が存在しなかったら末尾にコピー挿入する
                ■２　↑で追加したシートの名前をMyRNG.Value　に変える
            End If
        Next
    End Sub

＞仕組みはわかったと思います。
こうすればいいということは理解できたんですよね？

いま、どういう風にしていて、どう困っているのか（エラーが出ているなら、発生個所およびエラー番号とその内容を、エラーは出ないが想定してない動きとなっているなら、××になるはずが、△△となってしまうなど）具体的に説明してもらえれば、アドバイスできることがあるかもしれません。

（もこな２） 2021/01/12(火) 11:24

もこな2様

申し訳ございません。
自分が最初に書いていたコードに必要で、教えて頂いた方法にした時に不要な文字列を理解できておりませんでした。
再度、試行錯誤しまして、下記のコードで想定している動きをすることができました。
何度も、回答いただきありがとうございました。

Private Sub CommandButton2_Click()
Dim 列 As Long

 Set ws = Worksheets("一覧")

 For 列 = 5 To Cells(6, Columns.Count).End(xlToLeft).Column
     If Cells(6, 列).Value <> "" Then
        flg = True
        'シートの存在チェック
        For Each chkWs In Worksheets
            If chkWs.Name = ws.Cells(6, 列) Then
               flg = False
               Exit For
            End If
        Next chkWs
        '同じシート名がない場合のみ追加
            If flg Then
        '最後尾にシートを追加します
               ThisWorkbook.Sheets("計算書フォーマット").Copy After:=Sheets(Sheets.Count)
               Set addWs = ActiveSheet
        '追加されたシートに名前を付けます
            addWs.Name = ws.Cells(6, 列)
            End If
     End If
 Next
End Sub
（ぬぬぬ） 2021/01/12(火) 11:47

解決したようですが、何点か。

◆１
「標準モジュール」で「Cells(6, 列)」のような書き方をした場合、「ActiveSheet.Cells(6, 列)」のようにアクティブシートを指定したものとして扱われます。
したがって、想定外のシートを対象にしないためにも、対象のブックやシートは明示したほうがよいとおもいます。

◆２
Rangeオブジェクトのプロパティを省略した場合、Valueプロパティが指定されたものとして扱われるルールです。
したがって、ws.Cells(6, 列)のような書き方でも問題ありませんが、慣れないうちは「Valueプロパティ」まできちんと書いたほうが無難に思います。

◆３
提示されたコードを拝見すると「ws」「flg」など宣言していない変数が見受けられます。
問題があるわけではありませんが↓を読んでみてください。（私個人としては、変数の宣言を強制するようにすることをお勧めします）
http://officetanaka.net/excel/vba/beginner/06.htm

 上記を踏まえるとこんな感じです。 興味がわいたら研究してみてください。（シートの存在判定は前トピックを参照してください）

    Option Explicit

    Private Sub 整理()
        Dim WS As Worksheet
        Dim tmpSH As Worksheet
        Dim 列 As Long
         Set WS = Worksheets("一覧")

        For 列 = 5 To WS.Cells(6, WS.Columns.Count).End(xlToLeft).Column
            If WS.Cells(6, 列).Value <> "" Then
                Set tmpSH = Nothing
                On Error Resume Next
                Set tmpSH = ThisWorkbook.Sheets(WS.Cells(6, 列).Value)
                On Error GoTo 0

                '▼シートが存在しないときだけ処理
                If tmpSH Is Nothing Then
                    ThisWorkbook.Sheets("計算書フォーマット").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = WS.Cells(6, 列).Value
                End If
            End If
        Next 列
    End Sub

（もこな２） 2021/01/12(火) 12:34

 解決されていますが、少しだけ補足させてください。
 （いくつか指摘がかぶってます！）

 まず、変数の宣言を強制しませんか？
https://www.239-programing.com/excel-vba/basic/basic032.html
 現状だと、「列」しか宣言されておらず、wsもchkWsもflgもaddWsもナニモノなのか他の方が見たらわからないと思います。

 次に、せっかくwsを宣言しているのに、
 ＞ For 列 = 5 To Cells(6, Columns.Count).End(xlToLeft).Column
                 ~↑~
 ここにいらっしゃらない。
 後々エラーの原因になるので、是非付けたほうがいいと思いますよ。

 以下は私の自己満足の世界なので、流し読みしてください。

 ＞ 分かり易いコードは、それ自体がコメントでもある。
 この言葉に感慨を受けまして、もう少しわかりやすい表現とは何だろうと、下記の通り直してみました。

    Private Sub CommandButton2_Click()
        Dim 列 As Long
        Dim ws As Worksheet
        Dim shName As String
        Set ws = Sheets("一覧")
        For 列 = [E1].Column To ws.Cells(6, Columns.Count).End(xlToLeft).Column
            shName = ws.Cells(6, 列)
            If shName <> "" Then
                'シートの存在チェック（なければFlase）
                If Application.Evaluate("=ISREF(" & shName & "!A1)") = False Then
                    '同じシート名がない場合、最後尾にシートを追加し、シートに名前を付ける
                    Sheets("計算書フォーマット").Copy After:=Sheets(Sheets.Count)
                    Sheets(Sheets.Count).Name = shName
                End If
            End If
        Next
    End Sub
（稲葉） 2021/01/12(火) 12:35

もこな2さん
稲葉さん
度々回答していただき、ありがとうございます。
載せていただいたコードについては、勉強させていただきます。
誠にありがとうございました。

（ぬぬぬ） 2021/01/12(火) 15:25

コメント返信：

[ 一覧(最新更新順) ]

[[20210112094639]] 『空白セルをスキップして実行したい』（ぬぬぬ） ページの最後に飛ぶ

[[20210112094639]]　『空白セルをスキップして実行したい』（ぬぬぬ）　ページの最後に飛ぶ