実行時エラー1004について【超初心者です】
- Excelマクロ初心者が実行時エラー1004に遭遇し困っています。
- データ入力用のマクロを作成しましたが、実行時エラー1004が表示されます。
- マクロの内容は、入力画面で入力されたデータを別のシートに反映するものです。
- ベストアンサー
実行時エラー 1004について 【超初心者です】
マクロ超初心者です。 WindowsXP Excel 2003です。 データ入力用にマクロを作成してみましたが、 「実行時エラー 1004 アプリケーション定義・・・・」というメッセージが出てきます。 シート1「入力」を入力用画面として、 シート2「データ」にシート1で入力した内容が反映されるものです。 シート1「入力」の入力用画面はセルの結合が多く、 入力するセル以外はシートの保護をかけています。 下記のようなマクロです。 Sub 登録() ActiveSheet.Unprotect Password:="×××" 最終行 = Sheets("データ").Range("A" & Rows.Count).End(xlUp).Row + 1 Sheets("データ").Range("A" & 最終行).Value = 最終行 Sheets("データ").Range("B" & 最終行).Value = Range("C2:D2").Value Sheets("データ").Range("C" & 最終行).Value = Range("C3").Value Sheets("データ").Range("D" & 最終行).Value = Range("E3").Value Sheets("データ").Range("C2:D2").ClearContents Sheets("データ").Range("C3, E3").ClearContents MsgBox "登録しました" ActiveSheet.Protect Password:="×××", DrawingObjects:=True, contents:=True, UserInterfaceOnly:=True End Sub 超初心者で、何をどうしたらいいのかまったくわかりません。 なるべく専門用語がないように ご指導いただくとありがたいです。 非常に困っておりますので、よろしくお願いします。
- korino11
- お礼率100% (1/1)
- Windows XP
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
文字列の代入を行う際に、911文字を超えるとそのエラーが起きる事があるみたいだ。 >Sheets("データ").Range("B" & 最終行).Value = Range("C2:D2").Value >Sheets("データ").Range("C" & 最終行).Value = Range("C3").Value >Sheets("データ").Range("D" & 最終行).Value = Range("E3").Value 上記の値の代入で911文字以上の文字列を代入していないかチェックしてみよう。 【長い文字列配列を代入すると "実行時エラー 1004" が発生する】 http://support.microsoft.com/kb/818808/ja
関連するQ&A
- VBAでエラー時にメッセージを表示したい
こんばんわ！ エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになりますがその際にDATAシートにデーターが入っていませんとメッセージボックスが出る様にするにはどうすればいいでしょうか？ まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True End Sub
- ベストアンサー
- Visual Basic
- 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 上記のようにマクロを組みましたがエラーが出てしまいます。
- 締切済み
- その他（プログラミング・開発）
- エクセル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
- 実行時エラーの原因がつかめない（ＥｘｃｅｌＶＢＡ）
下記コードで実行時エラーの原因がつかめません。どなたか助けて ください。Sheet5のＡ，Ｂ列のデータを Sheet6 のＡ，Ｂ列に 一定の範囲で逆順にコピーする操作です。 Dim Dn As Integer, Zn As Integer Dn = Sheets("sheet1").Range("E37").Value / 8 + 0.5 Zn = Round(Dn) ‘ Sheets("Sheet6").Range("A1:A65536").ClearContents Xn2 = Sheets("Sheet3").Range("D65536").End(xlUp).Row - 5 Xn1 = Sheets("Sheet5").Range("A65536").End(xlUp).Row I = 0 Do Ix = I + 1 Iz = Xn1 - I Sheets("Sheet6").Range("A" & Ix & " : B" & Ix).Value _ Sheets("Sheet5").Range("A" & Iz & " : B" & Iz).Value I = I + 1 Loop Until I = Xn2 * Zn + 1
- ベストアンサー
- オフィス系ソフト
- エクセルのエラートラップについて
エクセルのVBAについて質問です。 以下のように組み込みDATAシートからフィルターをかけて抽出シートへ結果を表示するようになっていますが、DATAシートにデーターがない状態でするとエラーになります. そこで以前エラートラップの方法を教えて頂きました。 オフィス２００７では正常に動作します。 試しにオフィス２０００で実行するとDATAシートにデーターがあるなしに関わらずDATAシートにデーターがないと処理してしまうのですがエクセル２０００では無理なのでしょうか？ また回避方法があれば教えて頂きたいのですが、まだまだ勉強中の身ですので教えて頂ければ有難いです。 お手数ですが宜しくお願いします。 Sub 抽出() Application.ScreenUpdating = False Sheets("抽出").Activate Cells.Clear Sheets("抽出").Range("A1").Value = Sheets("DATA").Range("A2").Value Sheets("抽出").Range("B1").Value = Sheets("DATA").Range("B2").Value Sheets("抽出").Range("C1").Value = Sheets("DATA").Range("C2").Value Sheets("抽出").Range("D1").Value = Sheets("DATA").Range("D2").Value On Error GoTo MSG Sheets("DATA").Range("A3").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Sheets("検索").Range("A1:D2"), _ CopyToRange:=Sheets("抽出").Range("A1"), _ Unique:=False Sheets("抽出").Columns("A:D").AutoFit Application.ScreenUpdating = True Exit Sub MSG: MsgBox "DATAシートにデーターがない", vbCritical Application.ScreenUpdating = True End Sub
- ベストアンサー
- Visual Basic
- エクセル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 If Range("A" & 行1).Font.Bold 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 以下の用にマクロで変換する機能を追加したいのです AAAA5 9601 950 BBBB1-1 9660 150 BBBB1-2 9660 150 ASAS9 9654 50 AXCW5 9603 1375 宜しくおねがいします。
- 締切済み
- Visual Basic
- 印刷後のVBAの実行 (3)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします
- 締切済み
- オフィス系ソフト
- ExcelVBA 実行時エラー
お疲れ様です。 下記のExcelVBAでのプログラムなのですが、 なぜかいつもSelection.PasteSpecial Paste:=xlValuesの部分にデバック表示が出てしまいます。分かる方、少しのヒントでも良いので連絡ください。ちなみにプログラムは１９９７年にかかれたものです。 本当に困っています。宜しくお願い致します～。 ～～～～～～～～～～～～～～～～～～～～～～～～ Dim Bu, D_in, D_Copy As String D_Copy = ActiveSheet.Name 'マクロ実行Sheet(データ入力Sheetをコピー) Bu = Mid(D_Copy, 3, 3) '部コードを抽出 D_in = ("D-" & Bu) 'データ入力Sheet Msg = "前月データを複写してもよろしいですか?" Msg_ret = MsgBox(Msg, vbYesNo) If Msg_ret = vbNo Then End Else End If 'マクロ実行Sheetのデータをクリアする Range("Clear").Select Selection.ClearContents '上代売上単月データを一覧表にコピー Sheets(D_in).Select Select Case Month(Date) Case 4 Range("JT1,JT2").Copy Case 5 Range("JT3,JT4").Copy Case 6 Range("JT5,JT6").Copy Case 7 Range("JT7,JT8").Copy Case 8 Range("JT9,JT10").Copy Case 9 Range("JT11,JT12").Copy End Select Sheets(D_Copy).Select Range("B6").Select Selection.PasteSpecial Paste:=xlValues '在庫単月データを一覧表にコピー Sheets(D_in).Select Select Case Month(Date) Case 4 Range("Za1,Za2").Copy Case 5 Range("Za3,Za4").Copy Case 6 Range("Za5,Za6").Copy Case 7 Range("Za7,Za8").Copy Case 8 Range("Za9,Za10").Copy Case 9 Range("Za11,Za12").Copy End Select Sheets(D_Copy).Select Range("AD6").Select Selection.PasteSpecial Paste:=xlValues '上代売上累計データを一覧表にコピー ' 9月と3月はマクロの実行なし Sheets(D_in).Select Select Case Month(Date) Case 4 Sheets(D_Copy).Select Range("A6").Select End Case 5 Range("Ru1,Ru2").Copy Case 6 Range("Ru3,Ru4").Copy Case 7 Range("Ru5,Ru6").Copy Case 8 Range("Ru7,Ru8").Copy Case 9 Range("Ru9,Ru10").Copy End Select Sheets(D_Copy).Select Range("B52").Select Selection.PasteSpecial Paste:=xlValues End End Sub
- 締切済み
- その他（プログラミング・開発）
- 実行時エラー'1004'で困っています。
少し前にも同じコードの他の点についてアドバイスをいただいたのですが、新たな問題点が生じたので改めて質問させてほしいです。 具体的な問題点が分からなかったのでコードをそのまま載せました。 シート1に値を入力すると、繁殖牛データ。データ。という２個のシートから検索し、リンクをつけたいです。 繁殖牛データシートに入っている値を入力した時は ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'繁殖牛データ'!" & Range(Cells(kennsaku, 3)) データシートに入っている値を入力した時は ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'" & データ & "'!" & Range(Cells(kennsaku, 1)) で「'Range'メソッドは失敗しました：'_Worksheet'オブジェクト」とでます。 試験的にどちらのシートにも入っていない値を入力すると、思惑通りに"見つからないのでリンクは貼りません"と帰ってきます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim kennsaku, y, z If Target.Count > 1 Then Exit Sub 'セルを二つ以上選択した場合 If Target.Value = "" Then Exit Sub 'データが空の場合 If Application.CountIf(Range("A1:Z80"), Target.Value) > 1 Then MsgBox Target.Value & "は既に入力されています", vbOKOnly + vbExclamation Target.Clear Exit Sub End If Set y = Worksheets("繁殖牛データ").Range("$C$1:$C$1003") Set z = Worksheets("データ").Range("$A$1:$A$65536") kennsaku = Application.Match(Target.Value, y, 0) If IsNumeric(kennsaku) Then ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'繁殖牛データ'!" & Range(Cells(kennsaku, 3)) Else kennsaku = Application.Match(Target.Value, z, 0) If IsError(kennsaku) Then MsgBox "見つからないのでリンクは貼りません", vbOKOnly + vbExclamation Exit Sub Else ActiveSheet.Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'" & データ & "'!" & Range(Cells(kennsaku, 1)) End If End If Range("A1:Z80").Font.Underline = False End Sub
- ベストアンサー
- オフィス系ソフト
- 印刷後のVBAの実行 (2)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False ActiveSheet.Range("A1").Select End Sub 先日、上記のコードを回答者の方から教えてもらい、とても助かっていますが sheet1のD5に「不要」という文字が入っていた場合、 sheet3への貼り付け(23～30行目の作業)をキャンセルして、最後にsheet1のA1を選択するようにはどの様にしたらいいでしょうか?
- 締切済み
- オフィス系ソフト
お礼
kusa_mochiさん、ありがとうございました。 確かに文字列が多すぎたようです。 超初心者なので、コードが間違っているのかが 判断できなかったので、本当に助かりました。 マイクロソフトのサイトに載っていたんですね（汗） ご親切に教えていただいて、ありがとうございました。