- ベストアンサー
オブジェクトが必要???
- Excel VBAでデータの比較と抽出を行うコードを作成しましたが、「実行エラー:424 オブジェクトが必要です」と表示され動作しません。シート名を指定したり、他の試みもしましたが解決できません。どうすれば良いでしょうか？
- Excel VBAで「実行エラー:424 オブジェクトが必要です」というエラーが発生しています。データ比較と抽出を行うコードを作成したのですが、どうもうまくいきません。シート名を追加したり、他の方法も試しましたが解決できません。何か良い解決策はありますか？
- Excel VBAでデータの比較と抽出を行うコードを作成しましたが、「実行エラー:424 オブジェクトが必要です」というエラーメッセージが表示されてしまいます。シート名を追加したり、いくつかの方法を試しましたが、どうにもうまくいきません。どうすればエラーを解消できるでしょうか？
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- オブジェクトが必要です
またまた困ってます、、 このコードを実行したとき .Range("H" & i).Copy.wsDetail.Range ("D24") ここでエラーが起きて 「オブジェクトが必要です」 と言われてしまいます(・・;) だれかよろしくお願いします<m(__)m> ※シートの宣言は上でやってます Private Sub 社会保険() Dim i Dim endrow As Long Dim kihon As Long Set wshoken = Worksheets("各種保険料表") Set wsDetail = Worksheets("給与明細") Set wsData = Worksheets("データ入力") kihon = WorksheetFunction.Round(wsData.Range("C5"), -4) endrow = Cells(Rows.Count, 3).End(xlUp).Row With wshoken For i = 2 To endrow If kihon = .Range("C" & i) Then .Range("H" & i).Copy.wsDetail.Range ("D24") .Range("L" & i).Copy.wsDetail.Range ("H24") .Range("N" & i).Copy.wsDetail.Range ("L24") Application.CutCopyMode = False End If Next i End With End Sub
- ベストアンサー
- Visual Basic
- VBA マクロ エラー1004 アプリケーション定義またはオブジェクト定義のエラー
VBAで正当表と入力表の正誤判定を一気に行いたいのですが If Cells(a, b).Value = Cells(c, d).Value Thenの部分で エラー1004、アプリケーション定義またはオブジェクト定義のエラーと出てしまいます。 エラーの対処の仕方を調べたのですがわかりませんでした。 教えていただけるとありがたいです。 以下作ったプログラムです。 Sub 正誤判定() Dim a Dim b Dim c Dim d Dim e Dim i Dim j Dim x Dim y Dim hokan Dim ytate Dim xyoko a = 3 b = 21 c = 3 d = 43 e = 2 i = 1 j = 1 Do While j < 261 Do While i < 11 If Cells(a, b).Value = Cells(c, d).Value Then a = a + 1 c = c + 1 If Cells(a, b) = Cells(c, d) Then hokan = Cells(e, b).Value ytate = Range("B2:S15").Find(hokan, lookat:=xwhole).Row + 15 xyoko = Range("B2:S15").Find(hokan, lookat:=xwhole).Column Cells(ytate, xyoko).Value = Cells(ytate, xyoko).Value + 1 Else End If Else End If a = a - 1 c = c - 1 b = b + 1 d = d + 2 i = i + 1 Loop a = a + 3 c = c + 3 e = e + 3 j = j + 1 Loop End Sub
- ベストアンサー
- オフィス系ソフト
- VBA実行時のエラー
下記のプログラムは私が作った物では無いのですが、作った方と連絡をとる事が出来なくなってしまった為、質問させて頂きます。 このプログラムをシートから実行した所 エラー：400『既にフォームは表示されています。モーダルにできません。』 なるものが表示されてしまいます。 またコードを記述する所から実行しますと 実行時エラー：１００４『アプリケーション定義またはオブジェクト定義のエラー』 となってしまいます。 私の努力が足りないのは重々承知ですが、解決する事が出来ません。 皆様のお力を借りることが出来たらと思い投稿しました。 宜しくお願い致します。 Sub syoutotumen() Dim i As Long Dim j As Long Dim k As Long Dim kyori As Long Dim n As Integer n = 1 i = 1 j = 1 k = 1 Const cnsYEN = "\" Dim xlAPP As Application Dim objWBK As Workbook Dim strPATHNAME As String Dim strFILENAME As String strPATHNAME = "C:\Documents and Settings\tata41\デスクトップ\画像処理\" If strPATHNAME = "" Then Exit Sub strFILENAME = Dir(strPATHNAME & "dem******", vbNormal) If strFILENAME = "" Then MsgBox "このフォルダにはExcelワークブックは存在しません" Exit Sub End If Set xlAPP = Application With xlAPP .ScreenUpdating = False .EnableEvents = Fales .EnableCancelKey = xlErrorHandler .Cursor = xlWait End With Set WS1 = Worksheets("sheet1") Range("A1") = "0" Range("A2") = "1" Range("A1:A2").Select Selection.AutoFill Destinaton:=Range("A1:A512") Do While strFILENAME <> "" DoEvents If swESC = True Then If MsgBox("ESCが押されました。ここで終了しますか？", vbInformation + vbYesNo) = vbYes Then GoTo Button1_Click_Exit Else swESC = False End If End If xlAPP.StatusBar = trFILENAME & "処理中..." Set objWBK = Workbooks.Open(Filename:=strPATHNAME & cnsYEN & strFILENAME, UpdateLinks:=False, ReadOnly:=True) Do If Cells(i, 2) = 255 Then Exit Do i = i + 1 Loop Do If Cells(j, 3) = 255 Then Exit Do j = j + 1 Loop Do If Cells(k, 4) = 255 Then Exit Do k = k + 1 Loop kyori = (i + j + k - 21) / 3 WS1.Cells(n, 2) = kyori n = n + 1 i = 1 j = 1 k = 1 objWBK.Close savechanges:=False strFILENAME = Dir Loop GoTo Button1_Click_Exit Button1_Click_ESC: If Err.Number = 18 Then swESC = True Resume ElseIf Err.Number = 1004 Then Resume Next Else MsgBox Err.Description End If Button1_Click_Exit: With xlAPP .StatusBar = False .ScreenUpdating = True .EnableEvents = True .EnableCancelKey = xlInterrupt .Cursur = xlDefault Set objWBK = Nothing Set xlAPP = Nothing End With End Sub
- ベストアンサー
- オフィス系ソフト
- VB 2008: Do Whie...Loop文について
Function FileGetChar(ByVal f As String, ByVal p As Integer) As String Dim i As Integer = 1 Dim j As Integer = 0 Dim l As Integer Dim n As Integer = FreeFile() Dim c As Char If File.Exists(f) Then FileOpen(n, f, OpenMode.Random, OpenAccess.Read, , 1) l = FileLen(f) Do While (i + j <= l) FileGet(n, c, i + j) j = j - (Math.Abs(Asc(c)) > 255) i = i + 1 If i > p Then Exit Do Else c = "" End If Loop FileClose(n) End If Return c End Function [イミディエイトウインドウ] ? FileGetChar("D:\Temp\Test.txt",1) "1" ? FileGetChar("D:\Temp\Test.txt",2) "2" と、一応は動作しています。 l------->ファイル長 i+j----->読み込みのカレントポジション p------->読み込み指示ポジション 今、悩んでいるのはDo...Loop文中のIf Else End If の追放。 何か妙手があれば教えて頂きたい。
- ベストアンサー
- Visual Basic
- 結合セルが連続して複数存在する場合。
結合セルが連続して複数存在する場合。 vbaでどのようにしたら単体の結合セルが抽出できるでしょうか？ 環境はexcel2003です。（写真は2010ですが) よろしくお願い致します。 以下ソース Dim MergeArray(1000),Mergecount '配列 複数のセルを格納したい。,添え字 Dim i,j'while文で使用する。 Dim m, n '行,列 m = 1'行だけ動かす。 n = 2'列は固定する。 i = 1 j = 1 mergecount = 1 while i <= 1000 If Range(Cells(m,n),Cells(m + j,n).mergecells = True then while j <= 1000 If Range(Cells(m,n),Cells(m + j,n)).mergecells = false then MergeArray(mergecount)=Range(Cells(m,n),Cells(m + j,n))'->ここでエラーがでました。 MsgBox MergeArray(mergecount) mergecount = mergecount + 1 m = m + j End If j = j + 1 wend End If m = m + 1 i = i + 1 Wend
- ベストアンサー
- その他（プログラミング・開発）
- EXCEL VBA で列の数字のみを修正No.２
前回の応用の質問になります。 EXCEL VBA で列の数字のみを修正したいのですが 内容としては (1)カッコ内文字はそのまま維持 (2)添付資料のＮ００１から始まっているまたはＮ００１以外の始まる、ある機械加工プログラムに Ｎ053，Ｎ054を挿入しプログラム内容はそのまま変更なく使用 ここで始めたいＮナンバー数値（例Ｎ０７５からの連番）にマクロで変換したいのですが おすすめのコードを教えてください。 （※ＳＨＥＥＴ１のＡ列に記載されているとして） 前回の質問時はＮ００１からの連番を以下のコードでできました。 Sub test() Dim i As Long Dim j As Long Dim str As String i = 1 j = 1 str = Worksheets("sheet1").Range("A" & i).Value Do While str <> "" If Left(str, 1) = "N" Then str = "N" & Format(j, "000") & Mid(str, 5, Len(str) - 4) Worksheets("sheet1").Range("A" & i).Value = str j = j + 1 End If i = i + 1 str = Worksheets("sheet1").Range("A" & i).Value Loop End Sub いろいろコードを触ってみましたが思うように出来ずに困っています。 よろしくお願いします
- ベストアンサー
- その他MS Office製品
- マクロでのエラーについて
エクセル2010 マクロエラーについて 以前 印刷について下記コードを提示して頂きました。 このコードが通る時と2回目の .Zoom = j で止まる時があります。 どなたか検証して頂き、何が原因なのかご教示頂けますでしょうか？ 宜しくお願い致します。 Dim myRng As Range Dim i As Long Dim j As Long Dim k As Long j = 100 With ActiveSheet Set myRng = .Range("A1", .Cells(Rows.Count, "L").End(xlUp)).Resize(, 16) For i = 1 To myRng.Columns.Count If i = 11 Then .Columns(i).AutoFit End If Next i With .PageSetup .PrintArea = myRng.Address .Orientation = xlLandscape .PaperSize = xlPaperA4 .Zoom = j Do k = Application.ExecuteExcel4Macro("COLUMNS(GET.DOCUMENT(65))") If k = 1 Then Exit Do j = j - 1 .Zoom = j '”ここで実行時エラー1004” PageSetupクラスのZoomプロパティを設定できません” Loop End With .PrintOut Preview:=True .PageSetup.Zoom = 100 End With
- ベストアンサー
- Excel（エクセル）
- loop終了後のセルの一個右から同様のloopを行う方法
・loop終了後のセルの一個右から同様のloopのプログラムを組むのが目的です。 ・データはA列にランダムに数字が入っているものとします。 ・条件式としては基準値より小さな数字が一個下のセルにあったら↓を表示して、さらに下に行くという風にして、基準よりも多くなったところでloopがストップする設定です。 ・困っているところをうまく表現できてないかも知れませんが、よろしくお願いします。 --------------------------- Sub 比較() Dim i As Integer Dim j As Integer Cells(1, 2).Select ActiveCell.FormulaR1C1 = "=IF(RC1>R1C1,""→"",""↓"")" i = 1 Do While Cells(i, 2).Value <> "" If Cells(i, 2).Value = "↓" Then Cells(1 + i, 2).Select ActiveCell.FormulaR1C1 = "=IF(RC1>R1C1,""→"",""↓"")" End If i = i + 1 Loop Cells(i - 1, 3).Select ActiveCell.FormulaR1C1 = "=IF(RC1>R" & i - 1 & "C1,""→"",""↓"")" j = 1 Do While Cells(i - 2 + j, 3).Value <> "" If Cells(i - 2 + j, 3).Value = "↓" Then Cells(i - 1 + j, 3).Select ActiveCell.FormulaR1C1 = "=IF(RC1>R" & i - 1 & "C1,""→"",""↓"")" End If j = j + 1 Loop End Sub
- ベストアンサー
- Visual Basic
- VBAのglobalオブジェクトエラーについて
実績集計.xlsのマスターシートのA列の3行目のセルに「1」もしくは「スペース」が入っていて、1であれば隣の会社コード(0000775)をファイル名に付与して保存するというマクロを作成しています。 この行（code = Wsheet1.Range(counter, 2)）でエラーが出ていて、「アプリケーション定義、オブジェクト定義」とエラーがでてしまいます。どなたかわかる方がいらっしゃいましたら教えて下さい。よろしくお願いいたします。 Sub 作成() Dim counter As Integer '行番号 Dim code As String '取引先コード Set Wsheet1 = Workbooks("実績集計.xls").Worksheets("マスター") counter = 3 Do While counter < 10 If Wsheet1.Range(counter, 1) = "1" Then code = Wsheet1.Range(counter, 2) Workbooks.Add ActiveWorkbook.SaveAs Filename:="実績集計" + "_" + code + ".xls" End If counter = counter + 1 Loop End Sub
- 締切済み
- オフィス系ソフト
- １から入力された数までの素因数を数えるプログラム
こんにちは １から入力された数（N）までの素因数を数えるプログラムを 作成したいのですが、うまくいきません。 たとえば10と入力すると２と表示されてしまいます。 どこがおかしいのかわかりません。 どなたか教えてください。おねがいします。 N個の配列を用意し、１を入れていき、 素因数でない数の要素には０をいれて、 最終的に１が入っている配列の数を数えて１～Nまでの 素因数の数を数える方法を考えています。 Dim M As Integer Dim N As Integer Dim i As Integer Dim j As Integer Dim sum As Integer Dim L(1000) As Double N = Val(TextBox1) M = N i = 1 Do Until i > N L(i) = 1 i = i + 1 Loop i = 2 Do Until i > M j = i * 2 Do Until j > M L(j) = 0 j = j + 1 Loop i = i + 1 Loop sum = 0 For i = 2 To N If L(i) = 1 Then sum = sum + 1 End If Next i
- ベストアンサー
- Visual Basic
お礼
上記の注意点を踏まえて作り直したらうまく行きました。初心者なモノで、なにやらおかしな事をやっていたみたいです。ありがとうございます。