- ベストアンサー
VBA:実行時エラー1004
VBAにて以下のコードを実行すると実行時エラー1004が出ます。 dim tokuisakicode as string If Not Sheets("sheet2").Range("A" & cnt2).Value = Sheets("sheet2").Range("A" & cnt2 - 1).Value Then tokuisakicode = Sheets("Sheet2").Cells(cnt2, 1).Value ↓エラーが出る行 Sheets("A").Cells(1, cnt6).Value = tokuisakicode ↑エラーが出る行 cnt2 = cnt2 + 1 cnt6 = cnt6 + 1 Else cnt2 = cnt2 + 1 End If エラー1004は自分の経験上記述ミスなどのケアレスミスが多いのですが、今回は原因がどうしてもわかりません。 お分かりの方みえたらお教えください。
- kentaroror
- お礼率23% (31/134)
- その他MS Office製品
- 回答数5
- ありがとう数0
- みんなの回答 （5）
- 専門家の回答
質問者が選んだベストアンサー
Sheets("A")がない cnt6が0 のどちらかでしょう。
その他の回答 (4)
- Wendy02
- ベストアンサー率57% (3570/6232)
こんばんは。 省略されたコードで、本来ミスがあるのか分かりません。 その出されたコードがすべてなら、cnt2, cnt6 に代入値がありませんから、0 もしくは、負の値になるので、エラーが返ります。おそらく、Do ～ Loop などのループをしているのだろうとは思うのですが、回答者が見えない行を想像させられるのは、ちょっと酷です。 この場合、For ～ Next のほうがよいとは思います。行が3行減らせます。 cnt6 = cnt6 + 1 ここのインクリメントの行の位置が問題かもしれません。 Sheets("A").Cells(1, cnt6).Value = tokuisakicodeの前に入れるのかもしれません。 なお、別途、"A" & cnt2 - 1 のcnt2 が数値なら、コードは成立していますが、Cells と Range が混在していますから、Cellsに統一したほうが見やすいです。 それから、 If Not Sheets("sheet2").Range("A" & cnt2).Value = Sheets("sheet2").Range("A" & cnt2 - 1).Value Then 数値や文字判定なら、Not ... ではなくて、左辺 <>右辺 だと思います。間違いとは言いませんが。
- akina_line
- ベストアンサー率34% (1124/3287)
こんにちは。 「Sheets("sheet2").Range("A" & cnt2 - 1).Value」の記述で「"A" & cnt2 - 1」の部分が文字列と数値の演算がごっちゃになってます。 では。
- kmetu
- ベストアンサー率41% (562/1346)
cne2とcnt6が初期化されていませんが If Not Sheets("sheet2").Range("A" & cnt2).Value = Sheets("sheet2").Range("A" & cnt2 - 1).Value Then 上記の行でエラーが出ていますよ
- bin-chan
- ベストアンサー率33% (1403/4213)
> Sheets("A").Cells(1, cnt6).Value = tokuisakicode 「SheetA」とやらは存在しますか？ シートとセル指定がごっちゃでは？
関連するQ&A
- VBA 実行時エラー1004(その2)
毎度お世話になっております。 シート「sheet2」のA列のリスト内容を、シート「M_得意先」のリストからVLOOKUPして、指定のセルに書き出していくというコードを作成してみたのですが、VLOOKUPを実行する段階でエラーが出てしまいます。 少し変更して、同一シート内でのVLOOKUPは問題なく実行できたのですが...原因をご存知の方教えてください。 Dim b As String Dim endRcell2 As Long Dim cnt10 As long Sheets("sheet2").Select Sheets("sheet2").Range("A1").CurrentRegion.Select 'データ全体選択 Selection.SpecialCells(xlCellTypeLastCell).Select '最終行検出 endRcell2 = ActiveCell.Row cnt10 = 2 Do ↓実行時エラー1004が出る行 b = Application.WorksheetFunction.VLookup(Sheets("Sheet2").Range("A" & cnt10).Value, Sheets("M_得意先").Range(Cells(1, 1), Cells(endRcell, 2)), 2, False) ↑実行時エラー1004が出る行 Sheets("sheet2").Range("E" & cnt10).Value = b cnt10 = cnt10 + 1 Loop Until cnt10 = endRcell2
- ベストアンサー
- その他MS Office製品
- EXCEL VBAの配列でわかりません。
こんなコードがあるのですが、最後の他のシート（作業中シート）に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ～？？わからな～い？？おしえてくださーい！！ Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub
- ベストアンサー
- オフィス系ソフト
- Next,End Withのエラー
Sub 入力() If Sheets("入力").Range("D3").Value = "" Then MsgBox "客先名を入力して下さい" Else Dim K最終行 As Long Dim T最終行 As Long Dim i As Integer With Sheets("入力") For i = 3 To 12 If .Cells(i, "H").Value <> "" Then U最終行 = Sheets("注文書").Range("G65536").End(xlUp).Row + 1 If U最終行 = 461 Then MsgBox "注文書がいっぱいです" Exit Sub Else End If E最終行 = Sheets("営業確認").Range("G65536").End(xlUp).Row + 1 Sheets("営業確認").Range("k" & E最終行).Value = .Cells(i, "b").Value Sheets("営業確認").Range("b" & E最終行).Value = .Cells(i, "c").Value Sheets("営業確認").Range("c" & E最終行).Value = .Cells(i, "d").Value Sheets("営業確認").Range("d" & E最終行).Value = .Cells(i, "e").Value Sheets("営業確認").Range("g" & E最終行).Value = .Cells(i, "h").Value Sheets("営業確認").Range("f" & E最終行).Value = .Cells(i, "i").Value Sheets("営業確認").Range("i" & E最終行).Value = .Cells(i, "m").Value Sheets("営業確認").Range("h" & E最終行).Value = .Cells(i, "p").Value Else End If Select Case .Cells(i, "o").Value Case "北" K最終行 = Sheets("北").Range("h65536").End(xlUp).Row + 1 Sheets("北").Range("B" & K最終行).Value = .Cells(3, "C").Value Sheets("北").Range("c" & K最終行).Value = .Cells(3, "b").Value Case "中" T最終行 = Sheets("中").Range("H65536").End(xlUp).Row + 1 Sheets("中").Range("b" & T最終行).Value = .Cells(3, "c").Value Sheets("中").Range("c" & T最終行).Value = .Cells(3, "b").Value End Select Exit Sub Dim Dummy As Worksheet Dim SheetName As String Dim OTA As Long Dim GEN As Long Dim SheetName2 As String With Sheets("入力") '3行目～22行目まで For j = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, 14).Value 'もしシートがあれば・・・ If Err.Number = 0 Then 'SheetName2は入力シートのN行 SheetName2 = .Cells(i, 14).Value OTA = Sheets(SheetName2).Range("B65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("A7").Value = .Cells(3, "D").Value Sheets(SheetName2).Range("C3").Value = .Cells(3, "C").Value Sheets(SheetName2).Range("B" & OTA).Value = .Cells(i, "H").Value Sheets(SheetName2).Range("I" & OTA).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("F" & OTA).Value = .Cells(i, "K").Value Sheets(SheetName2).Range("H" & OTA).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("J" & OTA).Value = .Cells(i, "M").Value 'シートが無ければ・・・ Else GEN = Sheets("原紙").Range("B65536").End(xlUp).Row + 1 Sheets("原紙").Range("A7").Value = .Cells(3, "D").Value Sheets("原紙").Range("C3").Value = .Cells(3, "C").Value Sheets("原紙").Range("B" & GEN).Value = .Cells(i, "H").Value Sheets("原紙").Range("I" & GEN).Value = .Cells(i, "I").Value Sheets("原紙").Range("F" & GEN).Value = .Cells(i, "K").Value Sheets("原紙").Range("H" & GEN).Value = .Cells(i, "L").Value Sheets("原紙").Range("J" & GEN).Value = .Cells(i, "M").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName Next End With Exit Sub On Error GoTo 0 Sheets("原紙").Select Range("C3:E3,A7,B16:B35,F16:F35,H16:J35").Select Range("H35").Activate Selection.ClearContents Sheets("入力").Select Sheets("入力").Range("D3,G3:J12,L3:M12").Value = "" Sheets("入力").Range("D3").Select Range("B3").Formula = "=IF(D3="""","""",VLOOKUP(D3,'\\Seika-sv01\支店共有\マーケティング用\[担当者リスト.xls]リスト形式'!$B:$D,3,FALSE))" MsgBox "入力が完了しました" End If End Sub 上記のようにマクロを組みましたがエラーが出てしまいます。
- 締切済み
- その他（プログラミング・開発）
- Ｅｘｃｅｌ VBA 実行時エラー'1004':
どちらの処理がより高速であるのかを調べるため、以下の2つのVBAを試作致しました。 Sub Macroコピペ乱数() 'コピペ乱数 Sheets("Sheet4").Select Range("A1:A99999").Formula = "=RAND()" Columns("A").Value = Columns("A").Value Range("B1").Select End Sub 及び Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range("A" & i).Value = Rnd Next i Range("B1").Select End Sub 処が、これらのVBAを実際に動作させ様としますと、どちらの場合においても「Microsoft Visual Basic」ダイアログボックスが開いて 「実行時エラー'1004': 'Range'メソッドは失敗しました:'_Global'オブジェクト」 と表示されてしまいます。 さりとて、 Sub Macroコピペ乱数() 'コピペ乱数 Sheets("Sheet4").Select ActiveSheet.Range("A1:A99999").Formula = "=RAND()" Columns("A").Value = Columns("A").Value Range("B1").Select End Sub 及び Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range("A" & i).Value = Rnd Next i Range("B1").Select End Sub 或いは Sub Macro繰り返し乱数() '繰り返し乱数 Dim i As Long Randomize Sheets("Sheet4").Select For i = 1 To 99999 Range(Cells(i, 1)).Value = Rnd Next i Range("B1").Select End Sub 等としましても、今度は 「実行時エラー'1004': アプリケーション定義またはオブジェクト定義のエラーです。」 となってしまいます。 どの部分がどの様に悪いのでしょうか？ そして、どの様に修正すれば良いのでしょうか？ 尚、使用しておりますＥｘｃｅｌのバージョンはＥｘｃｅｌ2010です。
- ベストアンサー
- オフィス系ソフト
- VBA 実行時エラー９１がでてしまいます。
請求書を作成する課題をしているのですが、実行時エラー９１がでてしまいます。 売上シートにある受注番号セルに受注番号をを入力し、実行ボタンをおすとその受注番号とその列の受注日、宛名を請求書シートに表示させる課題です。 Private Sub 請求書作成ボタン_Click() Dim 売上, 請求書, 受注番号, 宛名, 受注日, 行 Set 売上= Sheets("売上") Set 請求書 = Sheets("請求書") 受注番号= 売上.Cells(2, 10) 請求書.Cells(8, 6) = 受注番号 行 = 売上.Range("A1,A31").Find(受注番号).Row 宛名 = 売上.Cells(行, 3) 請求書.Cells(3, 1) =宛名 受注日= 売上.Cells(行, 2) 請求書.Cells(9, 6) = 受注日 End Sub
- 締切済み
- Excel（エクセル）
- Visual Basic Editorの実行時エラーのことについて教えてください。
Visual Basic超初心者ですがよろしくお願いします。 標準モジュールで入力したものを実行すると、必ず「実行時エラー "53": ファイルが見つかりません。」と表示してしまいます。 入力したものはミスはないと思うのですが、何回やってもエラーが出てしまいます。 わかる方いましたら教えてください。 入力したものを一応載せときます↓ Sub list_file() Dim numfile As Long Dim i As Long With Application.FileSearch .NewSearch .LookIn = Range("b1").Value .Filename = Range("b2").Value .SearchSubFolders = Range("b3").Value If .Execute() > 0 Then file_count = .FoundFiles.Count MsgBox file_count & "files exis" Worksheets.Add after:=Worksheets("sheet1") Range("a1").Value = "filename" Range("b1").Value = "date" Range("c1").Value = "size" For i = 1 To file_count Cells(i + 1, 1).Value = .FoundFiles(i) Cells(i + 1, 2).Value = FileDateTime(.FoundFiles(i)) Cells(i + 1, 3).Value = FileLen(.FoundFiles(i)) Cells(i + 1, 2).Value = Hex(Cells(i + 1, 3).Value) Next Columns("a:c").AutoFit Else MsgBox "no file exists" End If End With End Sub
- 締切済み
- Visual Basic
- ＶＢＡの転記について
With Sheets("入力") '3行目～22行目まで For i = 5 To 24 SheetName = Sheets("入力").Cells(i, "C").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, "C").Value U最終行 = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 If U最終行 = 39 Then Sheets(SheetName2).Copy BEFORE:=ActiveSheet Sheets(SheetName).Delete End If If Err.Number = 0 Then A = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("C" & A).Value = .Cells(i, "G").Value Sheets(SheetName2).Range("D" & A).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("E" & A).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("F" & A).Value = .Cells(i, "N").Value Sheets(SheetName2).Range("G" & A).Value = .Cells(i, "P").Value Sheets(SheetName2).Range("H" & A).Value = .Cells(i, "R").Value Sheets(SheetName2).Range("I" & A).Value = .Cells(i, "T").Value Sheets(SheetName2).Range("K" & A).Value = .Cells(i, "V").Value Sheets(SheetName2).Range("L" & A).Value = .Cells(i, "X").Value ElseIf .Cells(i, "C").Value <> "" Then G = Sheets("原紙").Range("C65536").End(xlUp).Row + 1 Sheets("原紙").Range("B1").Value = .Cells(i, "D").Value Sheets("原紙").Range("B4").Value = .Cells(2, "D").Value Sheets("原紙").Range("C" & G).Value = .Cells(i, "G").Value Sheets("原紙").Range("D" & G).Value = .Cells(i, "I").Value Sheets("原紙").Range("E" & G).Value = .Cells(i, "L").Value Sheets("原紙").Range("F" & G).Value = .Cells(i, "N").Value Sheets("原紙").Range("G" & G).Value = .Cells(i, "P").Value Sheets("原紙").Range("H" & G).Value = .Cells(i, "R").Value Sheets("原紙").Range("I" & G).Value = .Cells(i, "T").Value Sheets("原紙").Range("K" & G).Value = .Cells(i, "V").Value Sheets("原紙").Range("L" & G).Value = .Cells(i, "X").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next i End With On Error GoTo 0 上記のＶＢＡを作成しましたが、 C行の値ごとの転記(Ｇ～Ｘの値)が出来ません。 どこが間違いか教えていただけないでしょうか。
- ベストアンサー
- Visual Basic
- VBAで実行時エラー1004が出ます
VBAで実行時エラー1004が出ます。 「Rangeメソッドは失敗しました。Worksheetオブジェクト」です。 あらゆる可能性を調べたのですが、分かりません。誰か教えて頂けますでしょうか？ 下記コードの「Cells(m, 7) =・・・」の部分がエラーになりました。 Sub ボタン1_Click() Dim 現シート As Worksheet ～ 現シート.Activate Cells(m, 7) = WorksheetFunction.VLookup(現シート.Range(現シート.Cells(m, 4)).Select, 現シート.Range(現シート.Cells(4, 104), 現シート.Cells(15, 107)).Select, 4, False) ～ End Sub 何卒宜しくお願いいたします。
- 締切済み
- Excel（エクセル）
- エクセル2003マクロの再編集
Sub test() Dim 行1 As Long, 最終行 As Long, 行2 As Long Sheets("Sheet2").Cells.ClearContents Sheets("Sheet1").Activate 最終行 = Range("C65536").End(xlUp).Row 行2 = 1 For 行1 = 1 To 最終行 Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Cells(行2, 3).Value = Abs(Sheets("Sheet2").Cells(行2, 3).Value) If Range("A" & 行1).Value = "BBBB1" Then Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1" Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2" 行2 = 行2 + 1 End If If Range("A" & 行1) = "" Then 行2 = 行2 - 1 Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1) End If 行2 = 行2 + 1 Next 行1 End Sub を編集したいのですが全然図りません ご指導お願いします 元データ AAAA5 9601 950 BBBB1 9660 150 ASAS9 9654 -50 AXCW5 9603 1375 以下の用にマクロで変換する用に出来たのですが 【1】 BBBB1だけではなくAAAA5も対処になったときの 追加方法です 元データは一切変更が出来ません ※フォントの変更も不可です 【2】 元データと変換後データがSheet1からSheet2になっていますが Sheet1の元は範囲はA1～C400で変換後をSheet1E1～G400にしたいのです AAAA5 9601 950 BBBB1-1 9660 150 BBBB1-2 9660 150 ASAS9 9654 50 AXCW5 9603 1375
- 締切済み
- Visual Basic
- 実行時エラー”1004”アプリケーション定義または
次のようなコードで10の平均と20の平均はエラーにならないのですが75の時のみエラーになります Sheets(SN).Cells(gyou, 22)のセルにはすべて数字があるのですがエラーになります。 エラー”1004”アプリケーション定義またはオブジェクト定義のエラー au = 100 sk1 = 10 sk2 = 20 sk3 = 75 If WorksheetFunction.Sum(Range("V90:V99")) <> 0 Then Sheets(SN).Cells(au, 24).Value = Application.WorksheetFunction.Average(Sheets(SN).Range(Cells(au - (sk1 - 1), 22), _ Sheets(SN).Cells(au, 22))) End If If WorksheetFunction.Sum(Range("V75:V99")) <> 0 Then Sheets(SN).Cells(au, 25).Value = Application.WorksheetFunction.Average(Sheets(SN).Range(Cells(au - (sk2 - 1), 22), _ Sheets(SN).Cells(au, 22))) End If If WorksheetFunction.Sum(Range("V25:V99")) <> 0 Then Sheets(SN).Cells(au, 26).Value = Application.WorksheetFunction.Average(Sheets(SN).Range(Cells(au - (sk3 - 1), 22), _ Sheets(SN).Cells(au, 22))) エラーの原因を教えてくださいよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
