アプリケーションまたはオブジェクト定義のエラーです
- 新規のレコードを追加入力するために新規入力ボタン(CommandButton2)を作成しましたが、エラーが出てしまいます。
- コードの確認およびエラーの指摘をお願いします。
- データを入力するシート「input」およびデータを格納するシート「data」があります。
- ベストアンサー
アプリケーションまたはオブジェクト定義のエラーです
データを入力するシート「input]、データを格納するシート 「data」とがあり、 新規のレコードを追加入力するために 新規入力ボタン(CommandButton2)を作成しましたが、 実行しようとすると、表記のエラーが出てしまします。 コードの確認、とそして、どこがいけないのかをご指摘いただけないでしょうか？どうかよろしくお願いいたします。 以下コードです。 Private Sub CommandButton2_Click() '新規入力 Dim row As Integer row = Sheets("data").Cells(Rows.Count, 2).End(xlUp).Offset(1) Sheets("data").Cells(row, 2).Value = Sheets("data").Cells(row - 1, 2).Value Range("AL1") = Sheets("data").Cells(row, 2).Value End Sub
- puyopa
- お礼率87% (459/525)
- オフィス系ソフト
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
まず最初の間違いは，VBAの予約語のRowを自前の変数名に使っているところです。 次の間違いは，Integerでは通常は足りません ダメ： dim row as integer 訂正： dim myRow as long エラーの直接の原因は まちがい：これじゃ「セルの値」を取り出している。 しかも空セルの。（＝０になる→次の行がエラーになる） row = Sheets("data").Cells(Rows.Count, 2).End(xlUp).Offset(1) 正解：下端の空きセルの「行番号」を調べる myRow = Sheets("data").Cells(Rows.Count, 2).End(xlUp).Offset(1).row
その他の回答 (1)
- nayuta_lot
- ベストアンサー率64% (133/205)
こんにちは 全体の処理がみえませんが、エラーになる理由は row = Sheets("data").Cells(Rows.Count, 2).End(xlUp).Offset(1) ではなく row = Sheets("data").Cells(Rows.Count, 2).End(xlUp).Offset(1).row のように、最後に.rowをつけていないからだと思われます。 後ろに.rowをつけないと値を取得してくれません。 従って、変数rowの中身が0となり エラーとなります。 あと、変数にrowのような、メソッド、プロパティで使用しているような文字をそのまま 変数として使用すると混乱の元なので、Last_row などのように定義したほうがいいですよ。 なにかあれば補足してください。 それでは
お礼
ありがとうございます。 参考になりました。
関連するQ&A
- VBA アプリケーション定義またはオブジェクト定義エラーについて
doc_wbkというブックのSheets(2)の内容をdoc_wbk2のActiveSheetにコピーしようとしています。 以下のコードの5行目で「アプリケーション定義またはオブジェクト定義エラー」が出てしまいます。ブックやシートまで指定しないといけないのかと思い doc_wbk.Sheets(2) を5行目行頭に追加しましたが変わりません。逆に5行目行頭の . を外してやるとアクティブシートの内容をコピーしてしまいます。Sheets(2)の内容をコピーしてやるにはどうしたらよいでしょうか?よろしくお願いします。 Set doc_wbk = Workbooks.Open(doc_dir + doc_file, 0) With Sheets(2) If .Range("A4").Value <> "" Then row_num = .Range("a65536").End(xlUp).Row .Range(Cells(4, 1), Cells(row_num, 11)).Copy doc_wbk2.ActiveSheet.Cells(row_num2 + 1, 1) End If End With
- ベストアンサー
- 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（エクセル）
- VBA アプリケーション・オブジェクト定義のエラー
ある行と別の行と同じ内容の文章が入っている場合、それを削除するマクロをくんでいますが、 アプリケーション・オブジェクト定義のエラーとのことで作動してくれません。。。 以下のような記述なのですが、アドバイスをいただけたら幸いです。 よろしくお願いいたします。 Sub 重複削除() Dim dataend Cells(Rows.Count, 5).End(xlUp).Select dataend = ActiveCell.Row For i = 2 To dataend - 1 For k = 1 To dataend - i If Cells(2, i).Value = Cells(2, i + k).Value Then '''''''''''''''''''''ここでひっかかる Rows(i + 1).Select Selection.Delete End If Next Next End Sub
- 締切済み
- Visual Basic
- VBA アプリケーション定義またはオブジェクト定義のエラーです
VBA初心者です。 仕事中、暇な時にVBAの勉強をしています。 あるファイルのフォーマットを指定されたフォーマットに変換するプログラムを作成しています。 実行後、「アプリケーション定義またはオブジェクト定義のエラーです」と出て、先に進めません。 どなたが分かる方、ご教授お願い致します。 以下ソース Private Sub CommandButton1_Click() ' 変数定義 Dim openFileName As String Dim priorYearBudget As String, thisYearBudget As String, increaseAnddecrease As String Dim bigSection As String, mediumSection As String, smallSection As String Dim fileLastRow As Long, buf As Long, index As Long Dim head As String ' 初期化 index = 2 ' ファイル名取得 openFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls") If openFileName <> "False" Then ' ファイルが存在したらファイルを開く Workbooks.Open openFileName ' 項目を変数に格納 ' bigSection = Sheets(1).Cells(1, 3) ' mediumSection = Sheets(1).Cells(1, 4) ' smallSection = Sheets(1).Cells(1, 5) priorYearBudget = Sheets(1).Cells(1, 6) thisYearBudget = Sheets(1).Cells(1, 7) increaseAnddecrease = Sheets(1).Cells(1, 8) ' ファイルの最終行を取得(データが格納されている行) fileLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row ' ワークシートの追加 Worksheets.Add after:=Worksheets("Sheet1") ' セルの幅指定 Columns("A").Select Selection.ColumnWidth = 70 Columns("B:D").Select Selection.ColumnWidth = 13 Columns("A").Select ' 幅設定で選択されたセルを解除 range("A1").Select ' 新規に追加されたワークシートに項目を設定 Sheets(2).Cells(1, 1).Value = "勘定科目" Sheets(2).Cells(1, 2).Value = priorYearBudget Sheets(2).Cells(1, 3).Value = thisYearBudget Sheets(2).Cells(1, 4).Value = increaseAnddecrease ' 元ファイルの見出しの形式を変更 For headCnt = 1 To fileLastRow head = Sheets(1).Cells(headCnt, 1) bigSection = Sheets(1).Cells(index, 3) midiumSection = Sheets(1).Cells(index, 4) smallSection = Sheets(1).Cells(index, 5) If head <> "" Then ' 項目設定 Sheets(2).Cells(headCnt, 1).Value = "【" & head & "】" End If If bigSection <> "" Then ' 大区分設定 Sheets(2).Cells(buf, 1).Value = bigSection←ここでエラー発生 ElseIf midiumSection <> "" Then ' 中区分設定 Sheets(2).Cells(buf, 1).Value = midiumSection ElseIf smallSection <> "" Then ' 小区分設定 Sheets(2).Cells(buf, 1).Value = smaillsection End If ' Sheets(2).Cells(cnt, 1).Value = head ' head = Sheets(1).Cells(cnt, 1) index = index + 1 buf = buf + 1 Next headCnt ' 元ファイルの金額をそのままコピー For budgetCnt = 2 To fileLastRow Sheets(2).Cells(budgetCnt, 2).Value = Sheets(1).Cells(budgetCnt, 6) Sheets(2).Cells(budgetCnt, 3).Value = Sheets(1).Cells(budgetCnt, 7) Sheets(2).Cells(budgetCnt, 4).Value = Sheets(1).Cells(budgetCnt, 8) Next budgetCnt Else MsgBox "キャンセルされました" Exit Sub End If End Sub 補足 エラーが発生する箇所をコメントアウトすると、正常に動作します。 よろしくお願い致します。
- ベストアンサー
- その他（プログラミング・開発）
- 全く作動しないです。（転記しないです。）
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 上記のようなコードですが、まったく作動しないです。 どこが間違っているのでしょうか。
- ベストアンサー
- オフィス系ソフト
- ExcelVBAで画像の様に動作を変更したいです
先日、こちらにて 教えていただいたマクロでのデータ突合方法を基にマクロを作成中なのですが、 画像の様に動作させるにはどう修正すればよいでしょうか （目標） 画像のSheet1 と Sheet2の商品コードを上から順に突合し、 Sheet3に合致したA品番をコピー Sheet4に合致したB品番をコピー Sheet5に合致しなかったA品番をコピー Sheet6に合致しなかったB品番をコピー ※なお、A品番B品番ともに同じ値の品番がいくつか存在することがある。 この場合は、ループ中既に合致したデータは対象から外す。 判別方法は品番の一つ横のセルに”〇”を表記。（フラグを立てる） 「A品番＝B品番」のとき「Offset(0, 1)が”〇”」ならば合致しない --------------------------------------------------- （手順） (1)Sheet1 あり Sheet2 ありの場合 →一致したSheet1とSheet2のOffset(0, 1)に”〇” →一致したSheet1の行全体の値をSheet3にコピー →一致したSheet2の行全体の値をSheet4にコピー (2)Sheet1 あり Sheet2 なしの場合 →該当するSheet1の行全体の値をSheet5にコピー (3)Sheet1 なし Sheet2 ありの場合 →該当するSheet2の行全体の値をSheet6にコピー --------------------------------------------------- （現在のコード） Sub Test() Dim c As Range, FRange As Range Dim Sh1 As Worksheet, Sh2 As Worksheet Set Sh1 = Worksheets("Sheet1") Set Sh2 = Worksheets("Sheet2") For Each c In Sh1.Range(Sh1.Cells(3, "A"), Sh1.Cells(Rows.Count, "A").End(xlUp)) Set FRange = Sh2.Range(Sh2.Cells(3, "A"), Sh2.Cells(Rows.Count, "A").End(xlUp)). _ Find(c.Value, LookAt:=xlWhole, After:=Sh2.Cells(Rows.Count, "A").End(xlUp)) If Not FRange Is Nothing Then If c.Value = FRange.Value And FRange.Offset(1, 0).Value <> "◯" Then c.Offset(0, 1).Value = "◯" '↓(1).xlsmSheet2に Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value FRange.Offset(0, 1).Value = "◯" End If Else '↓(1).xlsmのSheet3に Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value End If Next For Each c In Sh2.Range(Sh2.Cells(3, "A"), Sh2.Cells(Rows.Count, "A").End(xlUp)) If c.Offset(0, 1).Value = "◯" Then '↓(2).xlsmのSheet2に Sheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value Else '↓(2).xlsmのSheet3に Sheets("Sheet6").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value End If Next End Sub ご指導頂ければ幸いです。
- ベストアンサー
- Excel（エクセル）
- マクロ 行を切り取ってペーストでエラーになる
J列に「0」と「#N/A」の行を切り取って集計対象外シートに貼り付けるといったコードです。 何故か途中でエラーになります。 どこが間違っておりますか？ 宜しくお願いします。 Dim LastRow As Long LastRow = Cells(Rows.Count, 10).End(xlUp).Row For i = 1 To LastRow If Cells(i, 10) = "0" Or Cells(i, 10) = "#N/A" Then Rows(i).Cut Sheets("集計対象外").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End If Next i
- ベストアンサー
- Visual Basic
- ExcelのVBAでコピーのやり方
シート１のAL列の3行目以降の中から0以外の 値が入っているAJ列～AN列の行を全てコピーして、 シート２のＢ列～Ｆ列に貼り付けたいです。 シート２のＢ列～Ｆ列の7行目から下にコピーした値を入れていきたく、 値が入っていたらその次の行に貼り付けたいです。 例えば、7行目～15行目まで値が入っていたら、16行目から貼り付けるようにしたいです。↓のように書いてみたのですが、 コピーしている状態になるだけで、シート2の方へ貼り付けができない状態です。 また、オブジェクトが必要ですと表示が出ます。 どこをどうなおしたらいいでしょうか。 文章がわかりにくく申し訳ありません。 回答よろしくお願いいたします。 sub 値をコピー() Dim rTargetRange As Range, ii As Long Set rTargetRange = Nothing For ii = 4 To Cells(Rows.CountLarge, "AL").End(xlUp).Row If (Cells(ii, "AL").Value <> 0) Then If (rTargetRange Is Nothing) Then Set rTargetRange = Cells(ii, "AJ").Resize(, 5) Else Set rTargetRange = Application.Union(rTargetRange, Cells(ii, "AJ").Resize(, 5)) End If End If Next With Worksheets("sheet2") With .Cells(.Rows.CountLarge, "B").End(xlUp) If (.Row = 1 And .Value = "") Then rTargetRange.Copy .Offset(0) Else rTargetRange.Copy .Offset(1) End If End With End With End Sub また、↓のような違ったコードも試しましたが、 うまくいきませんでした。 N=Sheet2.Cells(Rows.CountLarge, "AL").End(xlUp).Row+1 SHEET1.SELECT For ii = 4 To Cells(Rows.CountLarge, "AL").End(xlUp).Row If Cells(ii, "AL").Valu e <> 0 Then RANGE("AJ" & ii & ":AN" & ii).COPY SHEET2.RANGE("B" & N) N=N+1 END IF NEXT
- 締切済み
- Excel（エクセル）
- マクロ ソートをしたいのですが、組み込めますか
マクロの説明 １．Sub Sample7()はsheet４の列をソートするマクロです。 (単独では、このマクロでソートできる) ２．Sub sample2()はsheet４のソート以外は完成しています。 やりたいこと Sub sample2()の中にsheet４の重複データを削除したもののソートのコードを組み込みたい。 但し、組み込むとしてSub Sample7()のコードでよいのか、初心者なのでよくわかりません。 なお、Sub sample2()のマクロは途中省いています。 Sub Sample7() Sheets("sheet4").Range("A1:A1135").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes End Sub Sub sample2() Dim data As Variant 'データコピー用の使いまわし配列 Dim dic As Object Dim i As Long Set dic = CreateObject("Scripting.Dictionary") 'Sheet4～5のA列をリセット Sheets("Sheet4").Range("A2:A" & Rows.Count).ClearContents Sheets("Sheet5").Range("C3:C" & Rows.Count).ClearContents ↓↓↓↓↓↓↓↓↓↓↓↓↓↓ 'Sheet4に重複していないデータを書き込み With Sheets("Sheet4") .Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(dic.Count).Value = Application.Transpose(dic.keys) 'Sheet4のC列をSheet5にコピー data = .Range("C2:C" & .Cells(Rows.Count, "A").End(xlUp).Row).Value End With Sheets("Sheet5").Range("C3").Resize(UBound(data)).Value = data Set dic = Nothing End Sub
- ベストアンサー
- Excel（エクセル）
- ユーザーホームでの検索について（エクセル）
コンボボックスで選択した文字とシートの表にある文字が一致か不一致かでMsgBoxに表示させるコードです。 一番上の行を選択しコマンド1ボタンを押すと正常に表示されるが2行目以降を選択すると一致不一致に関わらずすべて注意文が表示されます。 現在シート2,3ともとも10行目までデータがあります。今後データは下の行へと増える予定です。 コマンドボタン１のコード 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 どこが間違っているのか教えていただけないでしょうか。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
お礼
大変勉強になります、ありがとうございます。