実行時エラー1004発生するoffice2016

2023/09/06 23:20

このQ&Aのポイント

実行時エラー1004が発生しているoffice2016の問題です。sample1では正常に動作し、sample2では実行時エラー1004が発生しています。変数版のsample2では、デバッグモードでBUSHOが正しく表示されているが、何がおかしいのか分かりません。
質問文章では、office2016で実行時エラー1004が発生している問題について触れられています。sample1では問題なく動作するが、変数を使用したsample2では実行時エラー1004が発生します。デバッグモードで変数BUSHOの値を確認すると、正しく表示されているため、何が原因でエラーが発生しているのか理解できません。
office2016で実行時エラー1004が発生している問題についての質問です。sample1では正常に動作し、変数を使用したsample2では実行時エラー1004が発生しています。デバッグモードで変数BUSHOの値を確認すると、正しく表示されているため、エラーの原因が分からず困っています。

ベストアンサー

実行時エラー1004発生する

2020/02/20 18:49

office2016 下記でsample1は実行されますが、条件の中身を変数にしたsample2は、実行時エラー1004になります。 Sub sample1() Dim BUSHO As String Sheets("Sheet2").Select BUSHO = Worksheets("MASTER").Range("AI2") '判定 Range("F1:F" & Range("B" & Rows.Count).End(xlUp).row).Value = "=IF(AND(RC[-2]<>""mecha"",RC[-1]<>""mecha""),""削除"","""")" End Sub sample1で動作するのを確認してsample2の変数版を作成しています。なのでsample1ではBUSHO不使用です。 Sub sample2() Dim BUSHO As String Sheets("Sheet2").Select BUSHO = Worksheets("MASTER").Range("AI2") '判定 Range("F1:F" & Range("B" & Rows.Count).End(xlUp).row).Value = "=IF(AND(RC[-2]<>" & BUSHO & ",RC[-1]<>" & BUSHO & "),""削除"","""")" End Sub デバッグモードでBUSHOは”mecha"と表示されるのですが、何がおかしいのでしょう？

3620313
お礼率84% (217/257)

Excel（エクセル）
回答数1
ありがとう数2

みんなの回答 （1）
専門家の回答

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

ベストアンサー

kkkkkm
ベストアンサー率65% (1620/2459)

2020/02/20 19:23 回答No.1

Range("F1:F" & Range("B" & Rows.Count).End(xlUp).Row).Value = "=IF(AND(RC[-2]<>""" & BUSHO & """,RC[-1]<>""" & BUSHO & """),""削除"","""")" でどうでしょうか。

質問者

お礼 2020/02/21 09:36

ありがとうございます。助かりました。

関連するQ&A

VBA　実行時エラー　1004　の表示が出る
下記のVBAを作成していてエラーが出てしまいますやりたいこととしてはボタンを選択すると特定のシート[AAA]の最終行を取得して別シート[BBB]の2行目をシート[AAA]との最終行までコピーすることです --- Private Sub CommandButton_Click() Sheets("AAA").Range("A1", Cells(Rows.Count, 1).End(xlUp)).Offset(, 1).Resize(, 3).Formula = Sheets("BBB").Range("B2:D2").Formula End Sub
- ベストアンサー
- Visual Basic
アプリケーション定義または、オフジェクトエラー
office2010 マクロ実行で”アプリケーション定義または、オフジェクトエラー"が発生しますいろいろ調べてみたのですが、原因分からず、教えてください。 Sheet1のA1～A8までシート名が記載されています。このシート名の後ろにdataを付与してシートを追加し、編集用とするマクロです。 Macro13を実行してMacro1のエラー発生という所が黄色くなります。 ' Range("E1:S" & Worksheets(Worksheets("SHEET1").Cells(i, 1).Value).Range("B" & Rows.Count).End(xlUp).Row).Value = "=A1管理!RC[-4]" の場合は、動作します。なので、 Worksheets(""SHEET1"").Cells(i, 1).value! が悪いと思うのですが、どうしたらよいかが分かりません。 Dim i As Long Sub Macro13() ' Sheets("Sheet1").Select For i = 1 To Range("A1").End(xlDown).Row With Worksheets.Add() .Name = Worksheets("SHEET1").Cells(i, 1) & "data" Call Macro1 End With Next End Sub Sub Macro1() ' 各シートの整列版作成 ' 'データ参照 ' Range("E1:S" & Worksheets(Worksheets("SHEET1").Cells(i, 1).Value).Range("B" & Rows.Count).End(xlUp).Row).Value = "=A1管理!RC[-4]" '動作Ok Range("E1:S" & Worksheets(Worksheets("SHEET1").Cells(i, 1).Value).Range("B" & Rows.Count).End(xlUp).Row).Value = "=Worksheets(""SHEET1"").Cells(i, 1).value!RC[-4]"　’エラー発生 '下記は編集内容 'D列：F列を参照し、先頭６桁の右３文字がドライだったらTD、先頭６桁の右３文字がレンチだったらTL Range("D1:D" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(RIGHT(LEFT(RC[2],6),3)=""ドライ"",""TD"",IF(RIGHT(LEFT(RC[2],6),3)=""レンチ"",""TL"",""""))" '計算用に１行ダミー行挿入 Range("A1").Select Selection.EntireRow.Insert 'C列：E列を参照し、セル結合されているセルを名称、フロント、リアの区分名とする Range("C2:C" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(RC[2] <>0,RC[2],R[-1]C)" 'B列：E列を参照し、先頭１桁がNだったら名称、0だったらＢ列1つ上の名称 Range("B2:B" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(LEFT(RC[3],1)=""N"",RC[3],R[-1]C)" 'A列：B,C,D列を結合 Range("A2:A" & Range("E" & Rows.Count).End(xlUp).Row).Value = "=IF(RC[1]=RC[2],"""",CONCATENATE(RC[1],RC[2],RC[3]))" End Sub
- ベストアンサー
- Excel（エクセル）
R1C1形式について
Sub 合計() With Range("A2", Range("A" & Rows.Count).End(xlUp)) With .Columns(18) .FormulaR1C1 = "=if(count(rc[-9],rc[-8])=2,rc[-9]*rc[-8],"""")" .Value = .Value End With End With End Sub Sub 差引合計() With Range("A2", Range("A" & Rows.Count).End(xlUp)) With .Columns(8) .Formula = "=IF(COUNT(F2:G2),SUM($F$1:$F2)-SUM($G$1:$G2),"""")" .Value = .Value End With End With End Sub 2つのコードがありますが、1つ目のコードを2つ目のように、.Formula 形式？で変換をお願いできないでしょうか？－９はＪ列、－８はＫ列としてください。よろしくお願します。
- ベストアンサー
- オフィス系ソフト
全く作動しないです。（転記しないです。）
Private Sub CommandButton1_Click() If CheckBox1 = xlOn Then Worksheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) .Value = "新規" ElseIf CheckBox1 = xlOff Then Worksheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) .Value = "リピート" End If End Sub 上記のようなコードですが、まったく作動しないです。どこが間違っているのでしょうか。
- ベストアンサー
- オフィス系ソフト
マクロで困ってます！
マクロでセル検索かけたらそのセルに設定していたハイパーリンクが外れてしまいます。どうすればいいでしょうか・・？お力を貸してください！バージョンは2007です！コードは下記になります！同一ブック内の「データ」というシートにあるものを「検索更新」というシートで検索をかけるというものです。宜しくお願いします！！ Sub 検索2() myLAST = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1 If myLAST < 5 Then myLAST = 5 Range("A5:F" & myLAST).ClearContents Set myC = Sheets(1).Columns(3) _ .Find(What:=Range("E2").Value, _ LookIn:=xlValues, LookAt:=xlPart) ' If myC Is Nothing Then Exit Sub myCa = myC.Address Do myLAST = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1 Range("A" & myLAST) = myC.Row Range("B" & myLAST) = myC.Offset(0, -1) Range("C" & myLAST) = myC.Offset(0, 0) Range("D" & myLAST) = myC.Offset(0, 1) Range("E" & myLAST) = myC.Offset(0, 2) Range("F" & myLAST) = myC.Offset(0, 3) Set myC = Sheets(1).Columns(3).FindNext(myC) If myC Is Nothing _ Or myCa = myC.Address Then Exit Do Loop Set myC = Nothing End Sub Sub 更新() myLAST = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row If myLAST < 5 Then myLAST = 5 For Each myC In Range("A5:A" & myLAST) If myC.Value = "" Then Exit Sub With Sheets(1) .Range("B" & myC.Value) = myC.Offset(0, 1) .Range("C" & myC.Value) = myC.Offset(0, 2) .Range("D" & myC.Value) = myC.Offset(0, 3) .Range("E" & myC.Value) = myC.Offset(0, 4) .Range("F" & myC.Value) = myC.Offset(0, 5) End With Range("A" & myC.Row & ":F" & myC.Row).ClearContents Next MsgBox "更新しました" End Sub
- ベストアンサー
- オフィス系ソフト
実行時エラー1004空白セルを上に詰める
よろしくお願いしますいろいろ試しましたが解決できませんでした。 Private Sub CommandButton1_Click() With Worksheets("Sheet1") For r = 2 To .Cells(Rows.Count, "C").End(xlUp).Row If .Cells(r, "C").Value = 提出先.Value Then Me.提出先.Value = "" .Cells(r, "C").Value = "" Else End If Next r .Range("J3").Value = "" ’下記の構文でエラーが出ます ’実行時エラー1004 ’アプリケーション定義またはオブジェクト定義のエラーです .Range(Range("C2"), Cells.SpecialCells(xlCellTypeLastCell)).SpecialCells (xlCellTypeBlanks).Delete Shift:=xlUp End With End Sub
- ベストアンサー
- Visual Basic
VBAを実行しても結果が反映されない？？
下記のVBAを作成しましたが結果が反映されません ※実際は反映されているのかもしれませんが思うような結果ではありませんやりたいこととしてはボタンを選択すると特定のシート[BBB]の[B2:D2]をシート[AAA]の最終行と同じ行番号までコピーすることですおかしい個所をご指摘いただきたいです ※同様の質問を他の形でさせていただきましたがうまくいかなかったため新しく組み直したものです --- Private Sub CommandButton_Click() Dim ws As Worksheet Set ws = Worksheets("BBB") Range("B2:D2").Select Selection.AutoFill Destination:=Range("B2:D" & Sheets("AAA").Range("A1").End(xlUp).Row) Range("B2:D" & Sheets("AAA").Range("A1").End(xlUp).Row).Select End Sub
- ベストアンサー
- Visual Basic
複数行コピー、貼り付け実行時エラー1004
ユーザー側が任意の場所を選択コピーし(2行毎) また任意の位置に貼り付ける動作ですが 1回目のコピー、貼り付けは正常動作しますが再度コピー(任意の場所),貼り付け時に1004実行エラーが発生します。下記はコードです。どうかご教授お願いいたします。 Dim StartRow As Long, LastRow As Long, SRC As Long Sub コピー() If ActiveCell.Row < 76 Then Exit Sub StartRow = ActiveCell.Row: SRC = Selection.Rows.Count If (ActiveCell.Row Mod 2) = 0 Then StartRow = ActiveCell.Row If (Selection.Rows.Count Mod 2) = 0 Then LastRow = StartRow + Selection.Rows.Count - 1 Else LastRow = StartRow + Selection.Rows.Count End If Else StartRow = ActiveCell.Row - 1 If (Selection.Rows.Count Mod 2) = 0 Then LastRow = StartRow + Selection.Rows.Count + 1 Else LastRow = StartRow + Selection.Rows.Count End If End If ActiveSheet.Range(ActiveSheet.Cells(StartRow, 1), ActiveSheet.Cells(LastRow, 19)).Copy End Sub Sub 貼付け() If ActiveCell.Row >= 76 Or Application.ClipboardFormats(1) <> -1 Then ActiveSheet.Unprotect If (ActiveCell.Row Mod 2) = 0 Then StartRow = ActiveCell.Row Else StartRow = ActiveCell.Row - 1 End If ActiveSheet.Paste Destination:=Cells(StartRow, 1): Application.CutCopyMode = False ActiveSheet.Protect End If End Sub
- 締切済み
- Visual Basic
Excel2007で困ってます2
Sub test4() Worksheets("sheet2").Select Dim n As Byte, t As Byte n = Cells(Rows.Count, "O").End(xlup).Row + 1 t = Cells(Rows.Count, "ML").End(xlup).Row + 1 Range ("O" & n, "ML" & t).Select Selection = Worksheets("sheet1").Range("Y7:MV7").Value End Sub [test3でC3から始まる値をX5に入れる度に("Y:MV")に計算結果の値が出来上がります。その結果の値を、sheet2の("O3:ML3")には1から336の数字が振られていて、その下にその下にと次々と計算結果をコピーします。] test1からtest4を繋げたソースが私の力では無理でした。誰か教えてください。
- 締切済み
- Excel（エクセル）
VBAデータ元から新規ブックに出力
現在のブック内に出力されるとメモリの都合上時間がかかりすぎますそこで新規ブック１個に出力する構文を教えていただきたいのですが、宜しくお願いします。 Sub １１１１() Dim c As Range Dim i As Integer, LastRow As Long Dim NewSheetName As String, MatchFlag As Boolean Application.ScreenUpdating = False NewSheetName = "" With Sheets("データ元") For Each c In .Range(.Cells(3, "B"), .Cells(Rows.Count, "B").End(xlUp)) MatchFlag = False If NewSheetName <> Year(c.Value2) & "年" & Month(c.Value2) & "月" Then NewSheetName = Year(c.Value2) & "年" & Month(c.Value2) & "月" For i = 1 To Worksheets.Count If Sheets(i).Name = NewSheetName Then Sheets(i).Cells.ClearContents MatchFlag = True Exit For End If Next i If MatchFlag = False Then Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = NewSheetName End If End If LastRow = Sheets(NewSheetName).Cells(Rows.Count, "A").End(xlUp).Row Sheets(NewSheetName).Cells(LastRow + 1, "A").Resize(1, 6).Value = .Cells(c.Row, "A").Resize(1, 6).Value Sheets(NewSheetName).Columns("A:F").EntireColumn.AutoFit '↑A列からF列まで自動幅調整してます Next .Activate End With Application.ScreenUpdating = True MsgBox "終了しました", vbInformation End Sub
- ベストアンサー
- Visual Basic