VBA エラーの直し方がわからない

Question

ほかで使用しているマクロをそのまま転用しようとしましたが、エラーになってしまします。
初心者ですのでエラーの直し方がわかりません。
ほぼ同じ内容のシートでは作動するのに、新たに作成したシートでは作動しません。。。
教えていただけると幸いです。

エラーは以下の部分で、
Set ws2 = Sheets(ws1.Cells(wrow, "J").Value)

エラー9
入荷入力シートJ2-J7には数式が入っており、J2、J3は問題なく、
J4以降が空白のためエラー表記となっています
エラー時の　WROWは4となります。

Public Sub 転記()
Dim wrow As Long
Dim ws1 As Worksheet '入荷入力A2の値と同じ名前のシートの最終行にA2:D2とF2：G2の値代入
Set ws1 = Sheets("入荷入力")

Dim ws2 As Worksheet　’2行目から7行目を繰り返す
For wrow = 2 To 7
    'エラーのセルはスキップする
    If IsError(ws1.Cells(wrow, "J").Value) = False Then
        Set ws2 = Sheets(ws1.Cells(wrow, "J").Value)

        Dim TargetRng As Range
        Set TargetRng = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)

        TargetRng.Resize(, 4).Value = ws1.Range("A2:D2").Value
        TargetRng.Resize(, 2).Offset(, 5).Value = ws1.Range("F2：G2").Value
    End If
Next

End Sub

Comments

[hatena19]

Set ws2 = Sheets(ws1.Cells(wrow, "J").Value)
の行でエラーになるということですか。そのときるエラーメッセージは何でしょうか。
あと、そのときの ws1.Cells(wrow, "J").Value は存在するシート名になってますか。

[mi07]

エラー9
インデックスが有効範囲にありません
が表示されます。

Answer 1

前回の回答者です。

4行目エラーなので、2.3行目は問題ないと考えられます。
J列は全て同じ数式を組んでいるので、値自体に問題はないかと…
考えられるのは空白であることが、問題になっているのかなと思うのですが

「J4はエラーにはなっておらず、空白が表示されている。」と理解しました。
おそらく、IFERROR(何かの関数,"")のようになっており、空白が表示されていると思います。
ここで、念の為、確認ですが、空白は、長さ０の文字列("")であるということです。
もし、IFERROR(何かの関数," ")のようになっていると、半角のスペース１桁になります。
もし、IFERROR(何かの関数,"　")のようになっていると、全角のスペース１桁になります。
空白が長さ０の文字列("")であるという前提での、解決する為のコードは以下のようになります。

Public Sub 転記()
    Dim wrow As Long
    Dim ws1 As Worksheet   '入荷入力A2の値と同じ名前のシートの最終行にA2:D2とF2：G2の値代入
    Set ws1 = Sheets("入荷入力")

    Dim ws2 As Worksheet  '2行目から7行目を繰り返す
    For wrow = 2 To 7
        'エラーのセルはスキップする
        If IsError(ws1.Cells(wrow, "J").Value) = False Then
            '空白のセルはスキップする
            If ws1.Cells(wrow, "J").Value <> "" Then

                Set ws2 = Sheets(ws1.Cells(wrow, "J").Value)

                Dim TargetRng As Range
                Set TargetRng = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)

                TargetRng.Resize(, 4).Value = ws1.Range("A2:D2").Value
                TargetRng.Resize(, 2).Offset(, 5).Value = ws1.Range("F2：G2").Value
            End If
        End If
    Next

End Sub

もし、空白が半角１けたなら
If ws1.Cells(wrow, "J").Value <> "" Then
を
If ws1.Cells(wrow, "J").Value <> " " Then
にしてください。（全角の場合は同様に"　"にします）

Comments

[mi07]

空白スペースはありませんでしたが、
Set ws2 = Sheets(ws1.Cells(wrow, "J").Value)がエラーとなってしましました。

下記の通り解決しました。
教えていただきありがとうございました！

Answer 2

＞エラー9
＞入荷入力シートJ2-J7には数式が入っており、J2、J3は問題なく、
＞J4以降が空白のためエラー表記となっています

数式で空白に見えるように「””」を返しているのなら、
その値は「空白」ではなくて長さ0の「文字列」です。
また、シート名はいつでも自由に変えられます。（意図しててでも、無意識でも）
誤って削除する場合もあるかも知れません。
なので、存在確認をした方がよりよいかと思います。
（どんな数式をいれていて、どんな値が返ってくるのか解りませんが＾＾；）

Option Explicit

Public Sub 転記()
    Dim ws1 As Worksheet: Set ws1 = Sheets("入荷入力")
    Dim ws2 As Worksheet
    Dim rngSheetName As Range
    Dim rngTarget As Range
    Dim c As Range

    On Error Resume Next
    Set rngSheetName = ws1.Range("J2:J7").SpecialCells( _
                       xlCellTypeFormulas, xlNumbers + xlTextValues)
    On Error GoTo 0
    '指定の範囲の数式の返り値が全部数値か文字列以外なら終了
    If rngSheetName Is Nothing Then Exit Sub

    For Each c In rngSheetName.Cells
        '存在しないシート名があるときのエラー回避
        On Error Resume Next
        Set ws2 = Sheets(c.Value)
        On Error GoTo 0
        '存在したら転記
        If Not ws2 Is Nothing Then
            Set rngTarget = ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1)
            rngTarget.Range("A1:D1").Value = ws1.Range("A2:D2").Value
            rngTarget.Range("F1:G1").Value = ws1.Range("F2：G2").Value
        Else
            MsgBox c & "シートが存在しません。スキップします。", vbOKOnly
        End If
    Next
End Sub

上記のサンプルコードは、エラーを回避する一例を示したものであり、
数式の返す値が空白に見えるときの対応は、特に考慮されていません。
数式がどのような文字列で空白に見えるように返しているかで対応が変わると思います。
他の方が回答されてますので、それらも参考にしてみてください。
あと、参考にセルの指定方法を別の書き方で書いてみました。
ご自分で読みやすい方法で書いて下さい。

Comments

[mi07]

上記の方法だと１行目が４回繰り返し転記されてしまいました。
ただ、初心者にはこちらのほうがわかりやすいので、こちらで勉強させていただきます。
ありがとうございました。

Answer 3

エラーがでるのが、

Set ws2 = Sheets(ws1.Cells(wrow, "J").Value)

で、エラーメッセージが「インデックスが有効範囲にありません」だとしたら、
ws1.Cells(wrow, "J").Valueの値が存在しないシート名になっている可能性が大です。
あるいは、数値なら、0以下かシート数より大きい数値になっているかです。

そのセルには正しいシート名が入力されてますか。
前後に空白か含まれているとか、全角半角が異なってるとかないか確認してみてください。
数値なら、1からシート数の間の数値か確認してください。

Comments

[mi07]

4行目エラーなので、2.3行目は問題ないと考えられます。
J列は全て同じ数式を組んでいるので、値自体に問題はないかと…
考えられるのは空白であることが、問題になっているのかなと思うのですが、現在出先ですので明日もう一度確認してみます。

[hatena19]

同じ数式でも結果は異なる場合もありますよね。
というか同じ結果になるものを複数設定する必要性もないですし。
具体的にどのような数式を設定しているのですか。

Answer 4

If IsError(ws1.Cells(wrow, "J").Value) = False Then
↓
If Len(ws1.Cells(wrow, "J").Value) > 0 Then

Answer 5

set ws2 = Sheets(ws1.Cells(wrow, 10).Value)

この関数では"J"ではなく数値を入れるのだと思いますよ。

Comments

[mi07]

Jセルの値とするにはどうすればよいでしょうか？

[nanami12]

変数に格納してあげるだけでは？

[stdio]

Jは英語で何番目にくる文字かを考えましょう。
又はChr(65 + 10)と入力すればJという文字が取得できますのでその逆をすればいいのです。

[hatena19]

ws1.Cells(wrow, "J") という書き方は間違いでないです。Cellsの第2引数には列名（アルファベット）も指定できます。いちいち数字に変換しなくてもいいので結構便利に使ってます。

[nanami12]

出力されているエラーメッセージはなんですか？

[mi07]

エラーは
エラー9
インデックスが有効範囲にありません
が表示されます。

[hatena19]

エラーがでるのはどの行ですか。
Set ws2 = Sheets(ws1.Cells(wrow, "J").Value)
ですか。

[nanami12]

見ている箇所がJ列の様なので
このコードを先頭にきさいして動作させてみてください
ws.Columns(10).NumberFormatLocal = "@

[nanami12]

インデックスが有効範囲にありませんというエラーメッセージは
範囲内のデータにデータがない場合か範囲外のデータにアクセス
している場合です。上記コードは標準書式を文字列に変換するコードです

[nanami12]

WROWは4　の時に　空白な為エラーメッセージが表示されて
いるのかと想像し、その空白の列Jに対して文字列扱いにしてみて
どうなるかという意味で記載してます。