VBA ワークシート存在チェック

Question

Sheet7のA1からA7に下記画像のようにシート名を書き、これらのシートが存在するかチェックし、存在しない場合はSheet1に結果を表示したくて、下記のようにコードを書いたのですが、本当はSheet1のA1にSheet8は存在しませんSheet1のA2にSheet9は存在しませんと表示したいのですが、下記画像のようにSheet9は存在しませんといっぱい表示されてしまいます。どのように直したらいいでしょうか

Sub 存在シートチェック

Dim i As Long
Dim trgsheet As String
Dim ws As Worksheet
Dim Row As Long
Dim d As Long

Row = Worksheets("Sheet7").Cells(Rows.Count, 1).End(xlUp).Row
d = 0
  For i = 1 To Row
    trgsheet = Worksheets("Sheet7").Cells(Rows.Count, 1).End(xlUp).Value
    
    For Each ws In Worksheets
        If ws.Name <> trgsheet Then
            Worksheets("Sheet1").Range("A1").Offset(d, 0) = trgsheet & "は存在しません"
            d = d + 1
        End If
    Next
Next i
End Sub

Comments

[y_waiwai]

このままではコードが見れません。
質問を編集し、<code>ボタン、出てきた’’’の枠の中にコードを貼り付けてください

[tatsu99]

コードのおかしいところを指摘したいのですが、画像なので、こちらでコピペして、確認できません。
こちらでも、コピペして動作確認しますので、<code>ボタンをクリックして、その枠の中にコードを張り付けてください。

[kkk6]

修正依頼ありがとうございます。
質問を編集させていただきました。

Answer 1

とりあえず、修正しておきました。元のソースと見比べて、不明点があれば、再度質問してください。

Sub 存在シートチェック()

    Dim i As Long
    Dim trgsheet As String
    Dim ws As Worksheet
    Dim Row As Long
    Dim d As Long

    Row = Worksheets("Sheet7").Cells(Rows.Count, 1).End(xlUp).Row
    d = 0
    For i = 1 To Row
        trgsheet = Worksheets("Sheet7").Cells(i, 1).Value
        Dim flg As Boolean
        flg = False
        For Each ws In Worksheets
            If ws.Name = trgsheet Then
                flg = True
                Exit For
            End If
        Next
        If flg = False Then
            Worksheets("Sheet1").Range("A1").Offset(d, 0) = trgsheet & "は存在しません"
            d = d + 1
        End If
    Next i
End Sub

Comments

[kkk6]

ご回答ありがとうごさいます。
助かりました。

Answer 2

画像を見て判断すると、下記の部分がおかしいですね。

  '前略

  For i = 1 to Row
    trgsheet = WorkSheets("Sheet7").Cells(Rows.Count, 1).End(xlup).Value

   '後略

これだと常にA列の最後の行を見ているので、trgsheetには常に"Sheet9"が代入されます。

簡単なことなのでどうしたらいいかは自分で考えてください。
（ヒント: A列の i行目を参照するように書き換える。）

---

追記

あと、For Each の部分も間違いですね。他の方の回答を参考にしてください。

ワークシートの存在チェックは For Each を使わない方法もありますので、おまけで紹介しておきます。

Sub 存在シートチェック()
    Dim i As Long
    Dim trgsheet As String
    Dim ws As Worksheet
    Dim Row As Long
    Dim d As Long

    Row = Worksheets("Sheet5").Cells(Rows.Count, 1).End(xlUp).Row
    d = 0
    For i = 1 To Row
        trgsheet = Worksheets("Sheet5").Cells(i, 1).Value
        On Error Resume Next
        Set ws = Worksheets(trgsheet)
        If Err.Number <> 0 Then
            Worksheets("Sheet1").Range("A1").Offset(d, 0).Value = trgsheet & "は存在しません"
            d = d + 1
        End If
        On Error GoTo 0
    Next i
End Sub

On Error Resume Nextでエラーを無視して次行へすすめる。
wsにtrgsheetシートを代入する。
もし、trgsheetシートが存在しなければエラーになる。
エラーなら Sheet1 に"存在しません"と出力する。

Comments

[kkk6]

回答と編集指摘ありがとうございます。

[kkk6]

回答ありがとうごさいます。
やってみます。