マクロコードについての質問

このQ&Aのポイント
  • マクロコードに関する質問です。
  • 特定のシート間でコードを動作させる際にエラーが発生しており、それを解消したいとのことです。
  • 具体的なエラーメッセージや発生条件についての詳細は記載されていませんが、他のエクセルを開くとエラーになるとのことです。
回答を見る
  • ベストアンサー

マクロコードについて教えて下さい!

下記のコードは教えていただいたコードなのですが、他のシートから計算表のシートにうつされると 時間計測をされるようになっています。 ですが、インターネットを開くには問題はないのですが、他のエクセルを開くと(1)の文のとこがエラーになってしまいます。エラーがでないようにすることはできないでしょうか??ぜひお力をかしてください。宜しくお願いします。 Sub timer_on() Dim i, myCol With Worksheets("計算表")     ←(1) For Each myCol In Array("f", "n") For i = 6 To .Cells(Rows.Count, myCol).End(xlUp).Row If .Cells(i, myCol).Value <> "" Then .Cells(i, myCol).Value = .Cells(i, myCol).Value + TimeValue("0:00:10") Next Next End With Application.OnTime Now + TimeValue("0:00:10"), "timer_on" End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • hattiyan
  • ベストアンサー率66% (2/3)
回答No.1

後で開いたエクセルのファイルがアクティブになり、そのファイルには”計算表”シートが無いためにエラーになるのだと思います。 アクティブにするファイルを指定してあげればよいかと思います。下記の(追加)の行を追加してみては... (当然"エクセルファイル名"は、それなりに) Sub timer_on() Dim i, myCol Workbooks("エクセルファイル名").Activate ←(追加) With Worksheets("計算表")     ←(1)

aoriika0625
質問者

お礼

なんとかできました!ありがとうございました(^^)

aoriika0625
質問者

補足

試してみましたが、今度はこのファイルを開いたら追加した文のとこがエラーになりました。

その他の回答 (1)

  • nattocurry
  • ベストアンサー率31% (587/1853)
回答No.2

横レス失礼します。 >追加した文のとこがエラーになりました。 まさか、そのまま記入してないでしょうね? 「エクセルファイル名」のところは、実際のファイル名に書き換えていますよね?

aoriika0625
質問者

補足

もちろんファイル名を入れて試しました。どうしてエラーになるのか私では分かりません。。。。。

関連するQ&A

  • 質問No.2259731で教えて頂いたコードを訳して欲しい

    昨日質問し、回答を頂いたものです。 もう少しで作業が上手くいきそうなのですが 教えて頂いたコードの各工程の意味(処理)がわからず 止まっています。 一つずつ調べてはいますが、かなり時間がかかっていて とても今日中に終わりそうになくて焦っています。 急いでいるもので、すいませんがどなたか下のコードの各行が どのような意味か、訳をつけて頂けないでしょうか。 Sub Test() Dim myCol As Integer, myVal Dim LRow As Long, myRow As Long With ActiveSheet  LRow = .Cells(65536, 1).End(xlUp).Offset(1, 0).Row  For myCol = .Range("IV1").End(xlToLeft).Column To 3 Step -1    myVal = 0    myRow = .Cells(65536, myCol).End(xlUp).Row    If myRow = 1 Then     .Columns(myCol).Delete    Else     Do While myRow > 1 And .Cells(myRow, myCol).Value <> "●"       myVal = myVal + .Cells(myRow, myCol).Value       myRow = myRow - 1     Loop     .Cells(LRow, myCol) = myVal    End If  Next myCol End With End Sub ちなみに元の質問内容は http://oshiete1.goo.ne.jp/kotaeru.php3?q=2259731 です。

  • VBAについて

    Excel2010使用。 VBA初心者である為、 何度か質問させていただきながら 回答いただいた内容に修正を加えつつ、 思いのものがひと通りできたと 解決していたつもりだったのですが、 動作確認をしたところ、一部不具合が生じました。 自己解決を試みているのですが、解決できず困っております。 どなたかお助けいただけないでしょうか? Private Sub 登録_Click() '登録ボタン押下で勤務表にデータを登録 Dim row As Integer Application.ScreenUpdating = False '画面更新の抑制 row = WorksheetFunction.CountA(Sheets("勤務表").Columns(1)) + 1 myCol = 1 Sheets("勤務表").Cells(row, 1).Value = Range("T2").Value Sheets("勤務表").Cells(row, 34).Value = Range("T1").Value For i = 8 To 22 Step 7 For j = 6 To 26 Step 2 If IsEmpty(Cells(j, i)) Then Exit For Else myCol = myCol + 1 With Sheets("勤務表").Cells(row, myCol) .Value = Cells(j, i).Value If LenB(StrConv(Cells(j, i).Value, vbFromUnicode)) > 8 Then '(1) ここを修正 .WrapText = True .Font.Size = 6 End If End With End If Next j Next i Sheets("勤務表").Cells(5, 22).Value = Range("P3").Value '月末日を移す Range("T1").ClearContents '連続入力の為、消去 Range("E6:G25").ClearContents Range("L6:N25").ClearContents Range("S6:U27").ClearContents Application.ScreenUpdating = True '抑制の解除 Range("T1").Select End Sub 上記コードを作成し、 入力用のシートから勤務表シートに 1人ずつ登録していくようにしております。 入力用のシートのH6:H24、O6:O24、V6:V26 (シートの都合により2行を1行に結合しています) このマクロを実行したところ、 V24までは転記ができているのですが、 V26だけが転記できない状況となっています。 CellsでいくとCells(22,26)まで範囲に入っていると 思うのですが・・・。 どこがおかしいのでしょうか?

  • 文字変換マクロについて

    数値を文字列に変換するマクロで、行数や列数が増えても対応できるようにしたいです。 (並びは…数値 スペース 文字列)どなたか教えてください。 よろしくお願いします。 Sub 文字() Dim i As Long For i = 1 To Range("A1").End(xlDown).Row Cells(i, "C") = Cells(i, "A") With Cells(i, "C") .NumberFormatLocal = "@" .Value = StrConv(Cells(i, "C").Value, vbNarrow) .Value = Format(Cells(i, "C").Value, "'00") End With Next i End Sub

  • マクロdictionaryオブジェクト書き換え

    ここで教えていただいたマクロを   シート1のF列を検索値として   シート2のA列を検索しヒットしたら   シート2の該当行のD列をシート1のAE列に転記。   データの2列目から行う。ヒットしない場合は 無 と転記。 と変更したくて記述を書き換えたらシート1が壊れてしまいました。 正しい記述を教えてください。 ↓教えていただいた書き換え前の正常動作する記述↓ Sub 検索() 'dictionaryオブジェクトを使用 'シート1のA列を検索値として 'シート2のA列を検索しヒットしたら 'シート2の該当行のE列をシート1のC列に転記 'データの2行目から行う。ヒットしない場合は無しと転記 Dim dic As Object Dim i As Long Dim v, w Dim t As Single t = Timer With Sheets("Sheet2") '返す値を指定E列 With .Range("E2", .Cells(.Rows.Count, 1).End(xlUp)) '検索する列指定 (1)=A列 v = .Columns(1).Value '返す値のある列指定 (5)=E列 w = .Columns(5).Value End With End With Set dic = CreateObject("scripting.dictionary") For i = 1 To UBound(v) dic(v(i, 1)) = i Next With Sheets("Sheet1") '検索値のある列指定 A列 With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)) v = .Value For i = 1 To UBound(v) If dic.exists(v(i, 1)) Then v(i, 1) = w(dic(v(i, 1)), 1) Else v(i, 1) = "無" End If Next '転記する列を指定 Offset(, 2)=検索値のA列より右2つ→C列 With .Offset(, 2) .ClearContents .Value = v End With End With End With Set dic = Nothing Debug.Print Timer - t End Sub ---- ↓書き換えておかしな動きになった物 ●の部分を変更しました↓ Sub 検索02() 'dictionaryオブジェクトを使用 'シート1のF列を検索値として 'シート2のA列を検索しヒットしたら 'シート2の該当行のD列をシート1のAE列に転記 'データの2行目から行う。ヒットしない場合は無しと転記 Dim dic As Object Dim i As Long Dim v, w Dim t As Single t = Timer With Sheets("Sheet2") '返す値を指定D列● With .Range("D2", .Cells(.Rows.Count, 1).End(xlUp)) '検索する列指定 (1)=A列 v = .Columns(1).Value '返す値のある列指定 (4)=D列● w = .Columns(4).Value End With End With Set dic = CreateObject("scripting.dictionary") For i = 1 To UBound(v) dic(v(i, 1)) = i Next With Sheets("Sheet1") '検索値のある列指定 F列● With .Range("F2", .Cells(.Rows.Count, 1).End(xlUp)) v = .Value For i = 1 To UBound(v) If dic.exists(v(i, 1)) Then v(i, 1) = w(dic(v(i, 1)), 1) Else v(i, 1) = "無" End If Next '転記する列を指定  'Offset(, 25)=検索値のA列より右25個→AE列● With .Offset(, 25) .ClearContents .Value = v End With End With End With Set dic = Nothing Debug.Print Timer - t End Sub

  • エクセル マクロ 抽出

    教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると 行数=値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub

  • ユーザーホームでの検索について(エクセル)

    コンボボックスで選択した文字とシートの表にある文字が一致か不一致かでMsgBoxに表示させるコードです。 一番上の行を選択しコマンド1ボタンを押すと正常に表示されるが2行目以降を選択すると一致不一致に関わらずすべて注意文が表示されます。  現在シート2,3ともとも10行目までデータがあります。今後データは下の行へと増える予定です。  コマンドボタン1のコード Private Sub cmd検索_Click() Dim i As Long For i = 4 To Sheets("sheet3").Cells(Rows.Count, 3).End(xlUp).Row If Sheets("sheet3").Cells(i, 3) = ComboBox1 Then MsgBox "商品 『 " & Sheets("sheet3").Cells(i, 3).Value & " 』 の在庫数は 『 " & Sheets("sheet3").Cells(i, 9).Value & " 』 です。" Exit Sub Else MsgBox "その商品は登録されていません。", vbExclamation Exit Sub End If Next i End Sub コンボボックスのコード Private Sub UserForm_Initialize() Dim i As Long With Worksheets("sheet2") For i = 4 To .Cells(Rows.Count, 3).End(xlUp).Row ComboBox1.AddItem .Cells(i, 3).Value Next i End With End Sub どこが間違っているのか教えていただけないでしょうか。 よろしくお願いいたします。

  • コードの、どこが間違ってますか?

    下記は、選択した1つのシートだけしか、実行されませんが、どこが間違ってますか? よろしくお願い致します。 ---- Sub 不要な行を削除する() Dim i As Integer On Error Resume Next For i = 9 To Worksheets.Count Worksheets(i).Range(Cells(4, 6).End(xlDown).Offset(2, 0).EntireRow, Cells(4, 6).End(xlDown).Offset(12, 0).EntireRow).Select Selection.Delete Shift:=xlUp Next i  End Sub ----

  • エクセルのマクロについて

    Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア~ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか?できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub

  • マクロ:データの抽出(複数条件)

    エクセルで以下のようなマクロを作成しました。 シート1のG列がシート2のF4と合致する時、シート2のC列にシート1のB列を貼り付けるのですが、条件を増やし 「シート1G列がシート2のF4と一致」かつ「シート1H列がシート2のG5と一致」かつ「シート1I列がシート2のH5と一致」かつ・・・としたいのですが、If Thenをどのように記述したらよろしいでしょうか。(AND関数の機能です) 宜しくお願いいたします。 Sub data01() With Sheets("Sheet1") x = .UsedRange.Cells(.UsedRange.Count).Row For i = 5 To x If .Cells(i, "G").Value = Worksheets("Sheet2").Range("F4").Value Then n = n + 1 Sheets("Sheet2").Cells(n + 5, "C").Value = .Cells(i, "B").Value End If Next End With End Sub

  • vbaのエラーを修正するコード(初心者です)??

    シートの c1セルに =a1+5 という式があります。 a10からa14にそれぞれ1,2,3,4,5と数字が入っています。 Sub 計算() If Cells(1, 3).Value < 10 Then Cells(1, 4).Value = 100 Else Cells(3, 1).Value End If End Sub Sub エラー() Dim i As Integer For i = 1 To 5 Cells(1, 1).Value = Cells(10 + i, 1).Value Application.Run "計算" Next i End Sub 以上のコードを書きます。 「Sub 計算」の4行目が不完全なのはあえてそうしています。 で、実行すると、当然ながらエラーが出ます。 そこで、実行時エラーを終了してa14に4.9と数字を手入力し、 再度「Sub エラー」を実行すると無事に終了です。 このエラー後の「終了→入力→実行」を「Sub エラー」の中に 書きたいんですが… 数式に関しては、例示なので触れないでください。 あくまで手順を教えていただきたいのです。 何卒ご教授ください。

専門家に質問してみよう