• ベストアンサー
  • 困ってます

『続き』 質問番号:701776EXCEL_VBA

■質問番号701776の続きです。よろしくお願いいたします。 http://okwave.jp/qa/q7017764.html ■依頼内容 下記コードで アプリケーション定義またはオブジェクト定義のエラー(実行時エラー1004)を修正したい。 エクセルの関数で =IF(ISERROR(A1/B1),"",A1/B1) といった関数を作成すると、エラー値は非表示で、エラーでない場合のみ、計算しますが、 VBAで同様の式を利用しようとすると、エラーとなって実行できません。ご教授お願いいたします。 Sub macro1() Dim w As Workbook Dim mydate As Date, mydays As Long Set w = Workbooks.Open(Filename:=ThisWorkbook.Path & "\実験データ.xls") mydate = ThisWorkbook.Worksheets(1).Range("E1") mydate = mydate - Day(mydate) + 1 '念のため。 mydays = Day(DateAdd("M", 1, mydate) - 1) ThisWorkbook.Worksheets(1).Range("C5:I35").ClearContents With ThisWorkbook.Worksheets(1).Range("C5").Resize(mydays, 7) .Formula = "=IF(ISERROR(VLOOKUP($E$1-DAY($E$1)+$B5,[実験データ.xls]data!$B:$K,MATCH(C$4,[実験データ.xls]data!$B$1:$K$1,0))),"",VLOOKUP($E$1-DAY($E$1)+$B5,[実験データ.xls]data!$B:$K,MATCH(C$4,[実験データ.xls]data!$B$1:$K$1,0)))" .Value = .Value End With w.Close savechanges:=False End Sub

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数138
  • ありがとう数2

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

  • ベストアンサー
  • 回答No.2
  • keithin
  • ベストアンサー率66% (5278/7939)

>エクセルの関数で =IF(ISERROR(A1/B1),"",A1/B1) といった関数を作成すると、 >エラー値は非表示で、エラーでない場合のみ、計算します =A1/B1という数式がエラーになるのは, 1)エラーの具体的な内容が#DIV/0だった場合:  それはB1がゼロであるのがエラーの直接の原因なので,数式は  =IF(B1=0,"",A1/B1) とすれば良いことが判ります。 2)エラーの具体的な内容が#VALUE!だった場合:  それはA1かB1に「文字列」が記入されているのがエラーの直接の原因なので,数式は  =IF(COUNT(A1:B1)=2,A1/B1,"") などのようにすればよいことが判ります。 3)エラーの具体的な原因を追及するのがメンドクサイ場合:  その場合は,まぁどんなエラーでも対応できる  =IF(ISERROR(A1/B1),"",A1/B1) としても勿論構いません。 でも数式がシンプルにA1/B1程度ならまだしも,もっともっと長くなってきた場合でも,「長い(重い)数式」をイチイチ計算してエラーにならないかまず確認してから,改めて本番の計算を同じだけやり直すのを「不細工だ」と思わなければ,です。 >VBAで同様の式を利用しようとすると、エラーとなって実行できません。 新しいマクロの記録を開始します 所定のセルに =IF(B1=0,"",A1/B1) と数式を記入しEnterして実際に一度式を記入させてみます マクロの記録を終了し,採取できたマクロを参考にして,「この式を記入させる」には一体どんなマクロにすれば良かったのか確認します。 Sub Macro1() ' ' Macro1 Macro ' マクロ記録日 : 2011/9/20 ユーザー名 : keithin ' '  ActiveCell.FormulaR1C1 = "=IF(RC[-1]=0,"""",RC[-2]/RC[-1])"  Range("C2").Select End Sub むむー。。R1C1形式のマクロが録れてしまいましたが,まぁ肝心の「""」の部分が「""""」と書けばよい事が判ったことで良しとしましょう。 実際のC5セルに(若しくはC5:I35セルに) =IF(ISERROR(VLOOKUP($E$1-DAY($E$1)+$B5,[実験データ.xls]data!$B:$K,MATCH(C$4,[実験データ.xls]data!$B$1:$K$1,0))),"",VLOOKUP($E$1-DAY($E$1)+$B5,[実験データ.xls]data!$B:$K,MATCH(C$4,[実験データ.xls]data!$B$1:$K$1,0))) あるいは =IF(MEDIAN(MIN([実験データ.xls]data!$B:$B),$E$1,MAX([実験データ.xls]data!$B:$B))=$E$1,"",VLOOKUP($E$1-DAY($E$1)+$B5,[実験データ.xls]data!$B:$K,MATCH(C$4,[実験データ.xls]data!$B$1:$K$1,0))) といった数式を記入する操作を新しいマクロの記録でマクロに録って,どんなマクロの書きぶりをしたら正しく動作するのか,確認しながら作成してみてください。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

回答ありがとうございます。お礼が遅くなってすみません。 回答までの導き方まで、ご丁寧に教えていただきありがとうございました。 マクロを使うといった発想が全くなかったので、考え方の幅が広がりました。 keithin様のレベルには程遠いですが、少しでも精進させていただきます。 ありがとうございました。

関連するQ&A

  • VBAのエラーについて

    いつも識者の皆様にはお世話になっております。 Excel VBAのことで質問させてください。 Range("i23").Value = Application.VLookup(ThisWorkbook.Worksheets("aaa").Range("b5"), ThisWorkbook.Worksheets("data").Range("a2:b7"), 2, 0) というコードは通るのですが、 Range("i23").Value = Application.Left(VLookup(ThisWorkbook.Worksheets("aaa").Range("b5"), ThisWorkbook.Worksheets("data").Range("a2:b7"), 2, 0), 2) というleft関数を追加したコードだと「sub または function が定義されていません」というエラーになってしまいます。 VBAを始めたばかりなのですが、何か根本的な勘違いをしていますでしょうか? ちなみに Range("i23").Value = Application.Left(Application.VLookup(ThisWorkbook.Worksheets("aaa").Range("b5"), ThisWorkbook.Worksheets("data").Range("a2:b7"), 2, 0), 2) というコードも通りませんでした。 ご回答よろしくお願いいたします。

  • EXCEL2000とEXCEL2003のVBAについて

    現在、EXCEL2000で下記のコードを実行しています。 が、EXCEL2003で実行すると、 .UsedRange.Copy myb のコードが実行されているのにコピー出来ていません。 ファイルは開いていて、エラーは出ていないのです。 問題点わかる方教えていただけますか? Sub 日別データ読込() Dim rngsaki As Range Dim pathmacrobook As String Dim namebook As String Dim motobook As Workbook Dim myb As Variant Set rngsaki = Workbooks("残高集計用.xls").Worksheets(3).Range("a2") pathmacrobook = ThisWorkbook.Path & "\CSV読込データ12\" namebook = Dir(pathmacrobook & "*.xls") Do While Not namebook = "" Set motobook = Workbooks.Open(pathmacrobook & namebook) Set myb = Workbooks("残高集計用.xls").Worksheets(3).Range("A65536").End(xlUp) With motobook.Worksheets("Sheet1") .UsedRange.Copy myb End With motobook.Close False namebook = Dir() Loop MsgBox "完了しました" End Sub

  • Excel2007VBA 日付の加算について

    ●質問の主旨 コピー元のシートの特定セル(A3セル)に入力されている日付に対して 加算を行い、その加算した日付をシート名とコピー先の シートの特定セルに入力するためにはどうすればよいでしょうか? 具体的には下記のコードをどのように書き換えればよいでしょうか? 「Worksheets(i + 1).Name = mydate」のところでエラーが出てしまいます。 ご存知の方、ご教示願います。 ●コード Sub 一週更新() Application.ScreenUpdating = False Dim i As Integer Dim mydate As Date '既存のシート数を取得 i = ThisWorkbook.Worksheets.Count '最終シートをコピーして後ろに挿入 Worksheets(i).Copy after:=Worksheets(i) 'mydateは最終シートのA3セルに入力されている日付の1週間後の日付とする mydate = DateAdd("ww", 1, Worksheets(i).Range("A3")) '追加したシートのシート名はmydate2の日付とする Worksheets(i + 1).Name = mydate '新しく作成したワークシートについて以下の処理を行う With ActiveSheet Range("A3") = mydate Range("A12").ClearContents Range("A19").ClearContents Range("A26").ClearContents Range("A32").ClearContents End With Application.ScreenUpdating = True End Sub ●補足 上記コードは週単位の報告書を作成するためのコードです。 コピー元のA3セルは表示上は9/16となっており、 「セルの書式設定上」は「日付」→「3/14」, ロケールは日本語です。 私はVBA初心者です。

その他の回答 (1)

  • 回答No.1
  • imogasi
  • ベストアンサー率27% (4558/16317)

Sub test01() Range("C1").Formula = "=IF(iserror(A1/B1),"""",A1/B1)" End Sub を実行してみて。エクセル関数の埋め込みという点では、まく行くのでは。 VBAでエクセルの式の埋め込みはやらないほうが良いと思うが個人的な趣味だが。 ””のVBAにおける表現の経験が質問者には無かったからだけのような感じがする。 ーー また 依頼内容の上記の実例と、コードを貼り付けている実例(VLOOKUP等)と、違うじゃない。こういう質問の仕方はやると読者が迷惑する。 コード実例の Formula = "=IF(ISERROR(VLOOKUP($E$1-DAY($E$1)+$B5,[実験データ.xls]data・・が疑問点ならそれに絞ること。 ーー それまでのコード(日付をいじくっている部分?)も論点がぼやけるので、省いたほうが良いと思う。 読者・回答者が速く判りやすい質問の仕方を考えてください。それが質問者の思考の訓練に役立つ。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

全体のコードが見えたほうが良いと思って、そのまま全て載せてしまいました。 VBAの理解力をあげて、適切な質問ができるように精進いたします。ありがとうございました。

関連するQ&A

  • Excel2007 VBA 転記について

    ご指導のほどお願いします。 見積書からボタン300をクリックするとFAX送付状(テンプレート).xlsに下記内容が転記するように書いたのですが、質問させてください。 ("見積書").Range("c6")→("Sheet1").Range("e14")に貼り付けはうまく行きますが 本当は("見積書").Range("c6")&("見積書").Range("c8")=&"の件"を("Sheet1").Range("e14")に貼り付けしたいのです。 C6セル「○○○工場」 C8セル「○○○作業」 の件 ↑をE14セルに「○○○工場 ○○○作業の件」 として貼り付けたいです。 Sub ボタン300_Click() Workbooks.Open "\FAX送付状\FAX送付状(テンプレート).xls" ThisWorkbook.Worksheets("見積書").Range("a4").Copy Workbooks("FAX送付状(テンプレート).xls").Worksheets("Sheet1").Range("f6").PasteSpecial Paste:=xlPasteValues ThisWorkbook.Worksheets("見積書").Range("i8").Copy Workbooks("FAX送付状(テンプレート).xls").Worksheets("Sheet1").Range("AD9").PasteSpecial Paste:=xlPasteValues ThisWorkbook.Worksheets("見積書").Range("c6").Copy Workbooks("FAX送付状(テンプレート).xls").Worksheets("Sheet1").Range("e14").PasteSpecial Paste:=xlPasteValues  ActiveSheet.Range("F9").Value = Date End Sub ご指導のほどお願いします。

  • Setステートメントをまとめて記述する方法 (エクセル2000VBA)

    お世話になります。 Setステートメントで以下のように書いて、シート名を省略して使っています。  Set a = ThisWorkbook.Worksheets("い")  Set b = ThisWorkbook.Worksheets("ろ")  Set c = ThisWorkbook.Worksheets("は") これをプロシージャ毎に書くとコードが長くなるので、先頭かどこかに1回書くだけで、全てのプロシージャで使えるようにしたいのですがどうしたら良いでしょうか? このようなプロシージャを実行したいのですが、 Private Sub CommandButton1_Click()  a.Range("A2").Value = "データ1"  b.Range("B4").Value = "データ2"  c.Range("C9").Value = "データ3" End Sub (他にもコマンドボタンやチェックボックス用のプロシージャがあります) Setステートメントだけを先頭に書くと、 「プロシージャの外では無効です」というエラーが出ましたので、 Public Sub hensuu()  Set a = ThisWorkbook.Worksheets("い")  Set b = ThisWorkbook.Worksheets("ろ")  Set c = ThisWorkbook.Worksheets("は") End Sub のようにしたら、「実行時エラー"424":オブジェクトが必要です」というエラーが出てしまいました。 どのようにしたらエラーが出ず正しく動くようになりますでしょうか?よろしくお願いします。

  • 【excel vba】 時刻データのチェック

    dim myDate as Variant myDate = activesheet("xxx.xls").range("A1") if <<<myDateが、"hh:mm::ss"形式のデータかどうか? >>> then 処理1 end if と、したいのですが、 <<<・・・・・>>> の記述内容がわかりません。 ご教授お願い致します。

  • VBAで B.xlsの番号と同じ番号がD.xlsにあればくっつけたい

    VBAで B.xlsの番号と同じ番号がD.xlsにあればくっつけたい  エクセル関数でいうとVlookUPをしたいのですが、1004エラーがかかってしまいます。 必要なところだけを抜き取っているので、分かりにくいかと思いますが、   Dim a, b, c, d, y, x, z, i, j, k, m, n, o, r As Long a = 2 '2 なのは、A2から数えるため。 b = 0 'BookBのレコードの数を数えるための変数。 Do While Workbooks("B.xls").Worksheets("Sheet1").Cells(a, 1) <> "" a = a + 1 b = b + 1 Loop Workbooks("B.xls").Activate For k = 2 To b For m = 2 To 300000 エラー⇒ If Workbooks("B.xls").Worksheets("Sheet1").Cells(k, 1) = Workbooks("D.xls").Worksheets("Sheet1").Cells(m, 1) Then Workbooks("B.xls").Worksheets("Sheet1").Cells(k, 12) = Workbooks("D.xls").Worksheets("Sheet1").Cells(m, 2) Workbooks("B.xls").Worksheets("Sheet1").Cells(k, 13) = Workbooks("D.xls").Worksheets("Sheet1").Cells(m, 3) End If Next m Next k   ・   ・   ・ の部分でつまっています><; 説明が不十分でしたら追加いたしますので、初心者の簡単なエラーだとは思うのですが、教えてください<(__)>

  • Excelvba2000でExcelファイル間のコピーを行いたい

    現在マクロ実行中のExcelブックのシートのセルの値を、 新規作成したブックのシートのセルに値を貼り付けたいのですが、 うまくいきません。 ただし、コピーの条件として、クリップボードは使用しない Activeメソッドや、Selectメソッドも使用しないという制約があります 以前は、うまくいっていたのですが、コードの書き方を忘れてしまいました。以下の★印の行で、 「RangeクラスのCopyメソッドが失敗しました。」とエラーが出ます。 以前は、以下のコードに似た、ロジックで、問題なかったのですが、 どこか間違っていますでしょうか? Dim xlsApp As Excel.Application Dim xlsBook As Excel.Workbook Dim xlsSheet As Excel.Worksheet Set xlsApp = CreateObject("Excel.Application") Set xlsBook = xlsApp.Workbooks.Add Set xlsSheet = xlsBook.Worksheets(1) '★エラー発生 ThisWorkbook.Worksheets("Sheet1").Range("A1:D4").Copy _ Destination:=xlsBook.Worksheets("Sheet2").Range("E5")

  • Excel2003のVBAで教えてください

    以下のようなコードのプログラムを書いています。 使用しているシートは、"data"と"入力"という2つのシートです。 "入力"シート上で入力したデータを"data"シート上に追加していく予定です。 しかし、どうしても、"入力"シート上にペーストされてしまい"data"シート上にペーストすることができません。 Range("A" & z + 1).PasteSpecial Paste:=xlPasteValues が問題だとおもうのですが、これを Range("data!A" & z + 1).PasteSpecial Paste:=xlPasteValues と変更すると、実行時エラー1004になってしまいます。 アドバイスお願いします Private Sub CommandButton1_Click() Dim n As Integer Dim z As Long n = WorksheetFunction.CountA(Range("b9:b23")) Range("b51:f" & 51 + n - 1).Copy Set data = Worksheets("data").Range("A1") z = data.Rows.Count Sheets("data").Select Range("A" & z + 1).PasteSpecial Paste:=xlPasteValues MsgBox "登録しました" End Sub

  • VLookupで一致しなかった時のVBAでの処理

    On Error &#65374;を使わないで、 VLookup()で一致しなかった時の処理をさせたいのですが どのように記述すればよいでしょうか。 例えば、以下のようなコードの場合、 一致したデータがない時にyに-1を代入するには 以下のコードをどのように記述すればよいのでしょうか。 --------------------- Dim x As Integer Dim y As String x = 7 y = Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False) --------------------- 以下はいずれもエラーになりますが、以下のような感じで処理がしたいです。 --------------------- If IsError(Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False)) Then  y = -1 Else  y = Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False) End If --------------------- If Application.WorksheetFunction.IsNA(Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False)) Then  y = -1 Else  y = Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False) End If --------------------- y = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False), -1) --------------------- なお、以下のように本来エラーではない処理で On Error Resume Nextを使うのは、 本当のエラーの処理と混同するため不可 --------------------- On Error Resume Next y = Application.WorksheetFunction.VLookup(x, Worksheets("Sheet1").Range("A1:B100"), 2, False) If Err <> 0 Then y = -1 On Error GoTo 0 ---------------------

  • VBA .WorksheetFunctionについて

    Dim DestBook As Workbook Dim pathmacrobook As String Dim namebook As String Dim myb As Range Dim r As Long Application.ScreenUpdating = False ThisWorkbook.Activate pathmacrobook = ThisWorkbook.Path & "\" & Worksheets("sheet1").Cells(1, 3).Value & "\" Set DestBook = Workbooks("残高集計用.xls") namebook = Dir(pathmacrobook & "*.xls") Do While Not namebook = "" Set myb = DestBook.Worksheets("sheet3").Range("A65536").End(xlUp) With Workbooks.Open(pathmacrobook & namebook) r = aplication.WorksheetFunction.MatchThisWorkbook.Worksheets("sheet1") .Range("C3:AH3"), namebook.Worksheets("sheet1").Range("C"), 0) If r > 0 Then .Close False Else With Workbooks.Open(pathmacrobook & namebook) .Worksheets("Sheet1").UsedRange.Offset(1).Copy myb.Offset(1)      lngREC = lngREC + 1 .Close False End With End If namebook = Dir() Loop Set DestBook = Nothing MsgBox lngREC & "日分" & "読込完了しました" 上記のコードについてですが、修飾子が不正です。や、 Loopに対するDoがありません等エラーが出てしまいます。 やりたい事は、"namebook"を開いた時、"Thisworkbook"のsheet3のC列に"namebook"のsheet1のC列があれば、 "namebook"閉じ、そうでなければコピーするというようにしたいです。 どなたかご教授お願いします。

  • マクロをすっきりさせたい・・・

    いつもお世話になっております。 下記、マクロを組んだのですが、 簡潔にまとめるには、どうしたら良いでしょうか・・・ 宜しくお願い致します。 Set 範囲 = Workbooks("A.xls").Worksheets("マスター").Range("A2:G4000") ThisWorkbook.Activate 列番号 = 7 検索値 = (Worksheets("B").Range("B24")) Range("D14").Value = WorksheetFunction.VLookup(検索値, 範囲, 列番号, False) Set 範囲 = Workbooks("A.xls").Worksheets("マスター").Range("A2:G4000") ThisWorkbook.Activate 列番号 = 7 検索値 = (Worksheets("B").Range("B25")) Range("D15").Value = WorksheetFunction.VLookup(検索値, 範囲, 列番号, False) Set 範囲 = Workbooks("A.xls").Worksheets("マスター").Range("A2:G4000") ThisWorkbook.Activate 列番号 = 7 検索値 = (Worksheets("B").Range("B26")) Range("D16").Value = WorksheetFunction.VLookup(検索値, 範囲, 列番号, False)

  • VBA 初心者

    sheet1から、sheet2データを検索して抽出する練習をしているのですがerror"1104"が表示されます、なぜなのか分からないので投稿しました、よろしくお願いします。 sub test() dim sh1 as worksheets dim sh2 as worksheets dim  i  as  integer set sh1 = thisworkbook.worksheets("sheet1!") set sh2 = thisworkbook.worksheets("sheet2!") b = userform1.textbox1 for i = 1 to 10 sh1 .cells(i,2) = b b = b+1 x = sh1.cells(1,2) sh1.cells(i,3).value = worksheetfunction.vlookup(x,sh2.range("a1:d500"),2,false) next i end sub