質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.62%

関数の自動転記マクロ

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 2,796

MKHALFMOON

score 27

前提・実現したいこと

Excel VBAで他のシートのセルの内容を自動転記させるマクロです。
アプリケーション定義およびオブジェクト定義がどこでされるべきなのかも
分からない状態です。
関数自体は手打ちであれば問題なく動作します。

発生している問題・エラーメッセージ

実行時エラー'1004':
アプリケーション定義またはオブジェクト定義のエラーです。

該当のソースコード

Excel VBA
---以下、作成したコード---

Sub For_Next()
'変数の宣言
Dim i As Long '行数カウント
Dim s, sNum, sCell, sValue, temp As String

'loop
For i = 7 To 49
sNum = CStr(i)

'転記先のセル
sCell = "D" + sNum + ""

'参照元のセル
s = "3週!$BH" + sNum + ""

'代入する関数
sValue = "=IF(NOT((INDIRECT(""" + s + """))=""),INDIRECT(""" + s + """),"""")"

'実際にセルに表示される関数見本
'=IF(NOT((INDIRECT("3週!$BH7"))=""),INDIRECT("3週!$BH7"),"")

'転記先のセルを指定
Worksheets("4週").Activate
Range(sCell).Select

'転記処理をさせたい(ステップインがここで止まる)
ActiveCell.Range(sCell) = sValue

Next i
'loop end

End Sub

---作成したコード、終わり---

以上、宜しくお願い致します。

※2017/7/31追記
今回作成したかったVBAが完成致しました。
ご回答頂いた皆様ありがとうございました。

Option Explicit

Sub For_Next2()
    '変数の宣言
    Dim i As Long '行数カウント
    Dim s As String
    Dim sValue As String
    Dim rCell As Range
    Dim week As Integer
    week = 1

    'loop
    For week = 1 To 4
    '転記先のワークシートを指定
    Dim shtOut As Worksheet
    Set shtOut = Worksheets((week + 1) & "週")

        For i = 5 To 49
        '転記先のセル指定
        Set rCell = shtOut.Cells(i, "D")

        '参照元のセル
        s = "" & week & "週!$BH" & CStr(i) & ""

        '代入する関数
        sValue = "=IF(" & s & "="""",""""," & s & ")"
        '実際にセルに表示される関数見本  ※今回の内容であればINDIRECTを使う必要はないので、この式で十分だと思います。
        '=IF(3週!$BH7="","",3週!$BH7)

        '転記先のセルに関数式を反映
        rCell.Formula = sValue

        Next i

    Next week
    'loop end

End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

0

指摘したい点はいくつかありますが、現時点でエラーの原因となっているのはRange(sCell).Selectの部分のようですね。
上記を行いたいのであれば、たとえばActiveSheet.Range(sCell).Selectのようにシートを指定してあげれば動作すると思います。

ただ、今回提示いただいたコードは
①出力シート("4週")を選択
②出力セルを選択
③アクティブシートのアクティブセルに対して処理をする
という流れになっているようですが、アクティブシートやセルを切り替えながら行う処理は処理が重くなる原因にもなり、また処理中に他のExcelファイルが開かれたりするとそちらがアクティブシートになるため誤動作したりもします。

このため、アクティブシートやセルは切り替えず、参照や書き換えだけ行う方法をお勧めします。

以下は上記を盛り込んだサンプルです。

Sub For_Next2()
    '変数の宣言
    Dim i As Long '行数カウント
    Dim s As String
    Dim sValue As String
    Dim rCell As Range

    '転記先のワークシートを指定
    Dim shtOut As Worksheet
    Set shtOut = Worksheets("4週")

    'loop
    For i = 7 To 49
        '転記先のセル指定
        Set rCell = shtOut.Cells(i, "D")

        '参照元のセル
        s = "3週!$BH" & CStr(i) & ""

        '代入する関数
        sValue = "=IF(" & s & "="""",""""," & s & ")"
        '実際にセルに表示される関数見本  ※今回の内容であればINDIRECTを使う必要はないので、この式で十分だと思います。
        '=IF(3週!$BH7="","",3週!$BH7)

        '転記先のセルに関数式を反映
        rCell.Formula = sValue

    Next i
    'loop end

End Sub

参考になれば幸いです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/07/28 15:15 編集

    確かにご指摘頂いている行でステップインが中断されます。

    回答していただいたコードを
    Set shtOut = Worksheets("4週")

    Set shtOut = Worksheets("5週")

    s = "3週!$BH" & CStr(i) & ""

    s = "4週!$BH" & CStr(i) & ""

    のように単純に週数を変えて転記先が5週目の時だけ起こります。

    余談ですが、
    1週目から2週目、2週目から3週目、…、4週目から5週目
    と変数で週数を変えるForNextの中に回答のコードをネストさせてコンパイルエラーはなかったのですが、
    その場合も5週目に入ったところで
    値の参照:5週
    といったタイトルのウィンドウが立ち上がってしまいますので必要以上の
    参照処理が行われているとは何となく思います。

    セルの結合数や書式などが原因ではないかと転記元と先で同じになるよう
    見直しはしましたが、他で引っかかっているのでしょうか。

    キャンセル

  • 2017/07/28 15:37

    "5週"という名前のシートが存在しないのではないかと思います。
    全角半角の違い("5週"はNG)などはないでしょうか?

    キャンセル

  • 2017/07/31 09:47

    「5週」のシートにつきましてはシート名が「5週 」のように半角ブランクが混入していたのが原因でした。初歩的ミスでした…

    キャンセル

0

"が足りてないようです

sValue = "=IF(NOT((INDIRECT(""" + s + """))=""),INDIRECT(""" + s + """),"""")"

sValue = "=IF(NOT((INDIRECT(""" + s + """))=""""),INDIRECT(""" + s + """),"""")"

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.62%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る