Excel2000のマクロが2007で型が一致しませんと表示されます
- Excel2000のマクロがExcel2007で型が一致しないと表示されます。自作マクロを作成し、別のブックから転記するものですが、Excel2000では正常に動作するのに、Excel2007では転記対象のセルが0の場合にエラーが出てしまいます。
- マクロ初心者であるため、ExecuteExcel4Macroや型について調べましたが、理解できませんでした。解決策を知りたいです。
- 質問のコードは、1から7までの行のセルにExecuteExcel4Macroを使って別のブックのセルの値を転記するものです。転記対象のセルが0の場合には空白にするという処理を行っています。しかし、Excel2007では「型が一致しません」というエラーが出てしまいます。
- ベストアンサー
Excel2000のマクロが2007で型が一致しませんと表示されます
自作マクロを作成し別ブックから転記するものですがExcel2000では正常に動くのですが、Excel2007では、転記対象のセルが0なら空白にするという行（IF文）で「型が一致しません」と表示されてしまいます。 ExecuteExcel4Macroが悪いのか、いろいろ調べましたが型とは？などマクロ初心者なので分からないです。宜しくお願いします。 For i = 1 To 7 Cells(i, 1).Value = ExecuteExcel4Macro("'\[meca.xls]Sheet1'!R" & i & "C1") If ExecuteExcel4Macro("'\[meca.xls]Sheet1'!R" & i & "C1") = "0" Then Cells(i, 1).Value = "" Next i
- reimy1
- お礼率64% (244/379)
- オフィス系ソフト
- 回答数5
- ありがとう数6
- みんなの回答 （5）
- 専門家の回答
質問者が選んだベストアンサー
またまた登場、myRangeです。 ＞転記されるようになりましたが ということは、エラーの原因は先の回答のように meca.xlsの該当セルに●エラー値●があったから、という理解でいいですか？ それが一番重要なことですから、コメントした方がいいと思います。 また、「エラー値」が原因なら、 エクセルのバージョンに関係なく同じエラーになるはずです。（I'm Sure） ま、それは置いといて、補足の回答。 ＞1ステップごとに「値の更新」というダイアログボックスが出て コードの前後を、DisplayAlerts プロパティで挟みましょう。 '--------------------------------------------------------- Application.DisplayAlerts = False '●最初はFalse For i = 1 To 7 Cells(i, 1).Value = ExecuteExcel4Macro("'\[meca.xls]Sheet1'!R" & i & "C1") If IsError(Cells(i, 1).Value) Then Cells(i, 1).Value = "" If Cells(i, 1).Value = 0 Then Cells(i, 1).Value = "" Next i Application.DisplayAlerts = True '●最後はTrueに戻しておく '------------------------------------------- DisplayAleartsについてはご自分で調べてみてください。 そうすることがスキルアップにつながると考えます。 以上です。
その他の回答 (4)
- myRange
- ベストアンサー率71% (339/472)
回答３、myRangeです。 回答２で上手くいかなかったら（同じエラーが出たら） meca.xlsから読み込んでいるセルの値に●エラー値(#VALUE,#DIV/0等）があることが考えられます。 それは、meca.xlsを見なくてもCells(i,1)に転記されてるはずなので直ぐ確認できます。 もしエラー値が原因だったら、以下のようにエラー値を判断します。 '-------------------------- For i = 1 To 7 Cells(i, 1).Value = ExecuteExcel4Macro("'\[meca.xls]Sheet1'!R" & i & "C1") If IsError(Cells(i, 1).Value) Then Cells(i, 1).Value = "" If Cells(i, 1).Value = 0 Then Cells(i, 1).Value = "" Next i '--------------------------- エラー値だったら、空白を転記 ０だったら、空白を転記 マクロになれてきたら、On Error ステートメントを使うのもいいかも知れません。 以上です。
補足
myRange様。 細かい点まで解答していただいて感謝します。 転記されるようになりましたが 1ステップごとに「値の更新」という ダイアログボックスが出て その度にファイルを選び直さないと 値が転記されないのです。 どうすればよいでしょうか。
- myRange
- ベストアンサー率71% (339/472)
手元に2007がないので検証できないので何ですが。。。 ＞If ExecuteExcel4Macro("'\[meca.xls]Sheet1'!R" & i & "C1") = "0" Then Cells(i, 1).Value = "" の ="0" を = 0 にしてみてください。 それでダメなら、 ExecuteExcel4Macro("'\[meca.xls]Sheet1'!R" & i & "C1") を２度使う必要はないので、IF文を If Cells(i, 1).Value = 0 Then Cells(i, 1).Value = 0 に代えてみてください。 以上です。
- ro-chan
- ベストアンサー率38% (45/116)
度々すみません。 分かりやすいページがありました。 [開発]タブの[マクロのセキュリティ]でも設定できます。 ご参考まで。
補足
ご連絡ありがとうございます。事前にマクロは有効にしていました。 動作させた後で実行したら「型が一致しません」のエラーが表示されました。
- ro-chan
- ベストアンサー率38% (45/116)
マクロが無効になっているのではないでしょうか？エクセル2007では、標準の設定で、無効になっていると思います。それを、有効に設定すればよいと思います。
関連するQ&A
- 4.0マクロを Excel2003で実行？
以下のマクロはExcel2000までは動きますが、Excel2002、Excel2003では動きません。どのように修正すればよいのでしょう？ マクロのことは全くわかりません。10年以上前に友人からもらったExcelファイルです。 プログラムを修正してくれる業者をご存知の方は教えてください。 ' ' Sub Record1() For I = 1 To 15 Cells(50, 1).Value = Cells(51, 4) - Cells(52, 4) * (I - 1) Application.ExecuteExcel4Macro String:="SOLVER.XLA!SOLVER.OK(!R49C2,2,0,(最適化!R49C3:R49C13))" Application.ExecuteExcel4Macro String:="SOLVER.XLA!SOLVER.SOLVE()" SendKeys ("{ENTER}") Range("C49:M49").Copy Cells(31 + I, 3).Select Selection.PasteSpecial Paste:=xlValues Next I End Sub
- ベストアンサー
- Visual Basic
- ExcelのマクロをWSHから実行させると「型が一致しません」のエラーがでます。
WSHからExcel2000のマクロを実行させています。このマクロはセルの計算式の結果(セル(1,2))をif関数で比較するコードが入っています。 If Cells(1, 2).Value = "8月" Then hensu = 1 End If これをWSHから実行させると「型が一致しません」とエラーが出ます。 Debug.Print TypeName(Cells(1,2).Value)で型を表示させてみるとマクロを直接実行させたときはStringですが、WSHから実行させるとErrorとなっています。 なぜWSHから実行すると型がErrorとなるのかということと、解決策を教えていただければ幸いです。 ちなみにWSHでマクロを実行させている部分は以下のとおりです。 Set objExcelApp = CreateObject("Excel.Application") Set objWbk = objExcelApp.Workbooks.Open("ExcelBook.xls",True) objExcelApp.Run("ExcelBook.xls!macro1")
- ベストアンサー
- Visual Basic
- EXCELのVBAにて閉じたブックの数値を拾い出したいため
EXCELのVBAにて閉じたブックの数値を拾い出したいため ExecuteExcel4Macroを使用して次のように作成しましたが 生産管理ブック内の直出荷シートしか参照できません。 その他シートの参照して数値を拾い出したいため シートのループ処理(シート数不規則）を例えばworksheet(1)~処理終了の名前がついた シートまで行いたいのですがどの様に直出荷部分を書き込めばいいかわかりません。 いい方法を教えていただけ無いでしょうか？ (：と生産計画の間 エン[ がうまく表示できません） Dim i As Long, idx As Long Dim hi As Integer For hi = 10 To 252 If Cells(2, 3) = ExecuteExcel4Macro("'E:\生産計画.xls]直出荷'!R" & 11 & "C" & hi) Then Exit For End If Next hi i = 7 For idx = 7 To 3000 For i = i To 300 If ExecuteExcel4Macro("'E:\生産計画.xls]直出荷'!R" & idx & "C" & 5) = 0 Then Exit Sub End If Cells(i, 1) = ExecuteExcel4Macro("'E:\生産計画.xls]直出荷'!R" & idx & "C" & 5) Cells(i, 2) = ExecuteExcel4Macro("'E:\生産計画.xls]直出荷'!R" & idx + 2 & "C" & 5) Cells(i, 3) = ExecuteExcel4Macro("'E:\生産計画.xls]直出荷'!R" & idx + 11 & "C" & hi) i = i + 1 Exit For Next i idx = idx + 57 Next idx
- ベストアンサー
- オフィス系ソフト
- 最終保存日時の表示方法について
現在、下記のようなマクロで指定ディレクトリ内のフォルダ名を検索し、A3から下に標記 取得したフォルダ名の中にある「いろは.XLS」の「C9」の値をB3から下に標記 としております。「いろは.XLS」が必ずあるという前提でのマクロです。 Sub main() Const myPath As String = "D:\テスト\" Dim myFolder As String myFolder = Dir(myPath, vbDirectory) Dim r As Integer r = 3 Do While myFolder <> "" If myFolder <> "." And myFolder <> ".." Then If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then Cells(r, 1).Value = myFolder Cells(r, 2).Value = ExecuteExcel4Macro("'" & myPath & myFolder & "\[いろは.XLS]Sheet1 '!R9C3") r = r + 1 End If End If myFolder = Dir Loop End Sub 今回、C3から下に”各フォルダ内の「いろは.XLS」の最終保存日時”を標記し、「いろは.XLS」がない場合、ファイル名だけ取得したいのですが、どのようにすれば可能でしょうか？ ExecuteExcel4Macroについてはファイルを開かないで操作するそうなのですが、サイトのコピペで造っていくしかまだ出来ない知識ですので、この形になっております。
- ベストアンサー
- その他MS Office製品
- Excel VBA ExecuteExcel4Macroについて
こんにちは。よろしくお願いします。 あるフォルダ"D:\test"のなかに、４つのxlsファイル"o.xls"、"a.xls"、"b.xls"、"c.xls"があるとします。 使用するシート名は、それぞれo,a,b,c（ファイル名から".xls"を除いたもの）とします。 このとき"o.xls"を開いて、下記のマクロを実行すると、１行目にパス名、２行名にファイル名、３行目以下に（１列目は"a.xls"の、２列目は"b.xls"の、３列目は"c.xls"の）セルA3以下が読み込まれます。 たとえば、結果は添付の図のようになります。図がうまくアップできなかったらごめんなさい。 Sub sample1() Application.Calculation = xlManual Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next Worksheets("o").Cells.Clear Dim p As String, fn As String, fc As Long, i As Long, j As Long, d, e p = ActiveWorkbook.Path fn = Dir(p & "\" & "*.xls", 0) fc = 0 If fn <> "" Then fc = fc + 1 For j = 3 To 6 With Worksheets("o") .Cells(1, fc).Value = p & "\" & fn .Cells(2, fc).Value = fn d = ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R" & j & "C1") If d = 0 Or IsError(d) Then Exit For Else .Cells(j, fc) = d End If End With Next j End If Do fn = Dir() If fn <> "" Then fc = fc + 1 For i = 3 To 6 With Worksheets("o") .Cells(1, fc).Value = p & "\" & fn .Cells(2, fc).Value = fn e = ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R" & i & "C1") If e = 0 Or IsError(d) Then Exit For Else .Cells(i, fc) = e End If End With Next i Else Exit Do End If Loop Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlAutomatic End Sub 上記の例は変数iとjが3から6までしか動きませんし、読み込むxlsファイルも３つしかありませんのですぐに終わりますが、実際には行やファイルがもっとたくさんあり、非常に時間がかかっています。そこで、 ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R" & i & "C1") を e = ExecuteExcel4Macro("'" & p & "\[" & fn & "]" & Mid(fn, 1, Len(fn) - 4) & "'!R3C1:R6C1") というような風にして、For～Nextも使用せず .range(Cells(3, fc),cells(6, fc)) = e というふうに範囲で読み込もうとしたのですがうまくいきません。 ExecuteExcel4Macroは範囲を読み込むことはできないのでしょうか？ 何とかして処理速度を上げたいのですが、どうすればよいでしょうか。
- ベストアンサー
- その他MS Office製品
- ｅｘｃｅｌ；マクロ；表現をもっと縮小したい
質問します。下記のようなモジュールで中に同様の数字のみが順に変わるブロック繰り返しが多数あるのですが、もっと簡略化した表現 が可能でしょうか。よろしくお願いします。 Sub usb_count() d = Range("A65536").End(xlUp).Row j = 3 For i = 2 To d Select Case Cells(i, "B") Case Sheets("sheet2").Cells(4, "A") Sheets("sheet2").Cells(4, "B").Value = Sheets("sheet2").Cells(4, "B").Value + 1 If Cells(i, "K").Value = "USB" Then Sheets("sheet2").Cells(4, "C").Value = Sheets("sheet2").Cells(4, "C").Value + 1 Else Sheets("sheet2").Cells(4, "D").Value = Sheets("sheet2").Cells(4, "D").Value + 1 ' End If ‘------------------------------------------------------------------------------------------------------------------------------------ Case Sheets("sheet2").Cells(5, "A") Sheets("sheet2").Cells(5, "B").Value = Sheets("sheet2").Cells(5, "B").Value + 1 If Cells(i, "K").Value = "USB" Then Sheets("sheet2").Cells(5, "C").Value = Sheets("sheet2").Cells(5, "C").Value + 1 Else Sheets("sheet2").Cells(5, "D").Value = Sheets("sheet2").Cells(5, "D").Value + 1 End If ‘----------------------------------------- ‘以下上記の‘-----------から‘-----------で囲まれたブロックが（ ）内の数字が６から20まで繰り返され続く が略す End Select Next i End Su
- ベストアンサー
- オフィス系ソフト
- 型が一致しません
下記はセルが０の時、行全体を表示しないにするようにするＶＢＡですが、型が一致しませんとエラーになります、どこを直せばいいのですか。 Dim I As Integer Sub Macro4() For I = 4 To 76 If Cells(I, 8) = 0 Then Rows("I:I").Select Selection.EntireRow.Hidden = True End If Next I End Sub
- 締切済み
- Visual Basic
- 【Excelマクロ】もっと頭の良い書き方って無いかな？
5行空白列があったらそこで処理を終わりたいんですが、もっといい書き方はないでしょうか？ 下記が私の考えた頭の悪いやり方です。 Sub macro() Dim i As Integer For i = 1 To 1000 If Cells(i, 1) = "" Then If Cells(i + 1, 1) = "" Then If Cells(i + 2, 1) = "" Then If Cells(i + 3, 1) = "" Then If Cells(i + 4, 1) = "" Then If Cells(i + 5, 1) = "" Then MsgBox (i - 1 & "行目で終わりです") Exit For End If End If End If End If End If End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- VBA（ExecuteExcel4Macro）を用いた検索ツール
VBA（ExecuteExcel4Macro）を用いた検索ツール はじめまして。 当方Excel2007、winXPでの環境下でVBAを用いた検索ツールを作成しています。 検索対象のxlsファイルには1行目に郵便番号、氏名、住所の項目タイトル、2行目以降にデータが入力されています。 【現在の仕様】 検索対象のxlsファイルを選択→検索したい氏名（3つまで）を入力すると氏名列を順に検索し、該当した氏名のみをシートへ出力 【作りたい仕様】 検索対象のxlsファイルを選択→検索したい氏名（3つまで）を入力すると氏名列を順に検索し、該当した氏名の入力された行をシートへ出力 現在のソースは下記になりますが、どのように書き変えればいいのかが分からず困っています。 教えていただけたらと思います。よろしくお願いいたします。 ------------------------- （略） ''対象ブックを選択します OpenFileName = Application.GetOpenFilename("Microsoft Excel ブック,*.xls") If OpenFileName = "False" Then Exit Sub OpenFileName = Replace(OpenFileName, Dir(OpenFileName), "[" & Dir(OpenFileName) & "]") SheetName = InputBox("読み込むワークシート名を入力してください。") If SheetName = "" Then Exit Sub Target = "'" & OpenFileName & SheetName & "'!" On Error Resume Next buf = ExecuteExcel4Macro(Target & "R1C1") If Err <> 0 Then MsgBox "ワークシート [ " & SheetName & " ] を読めませんでした。", vbExclamation Exit Sub End If On Error GoTo 0 key1 = InputBox("検索したい氏名1を入力してください。") If key1 = "" Then Exit Sub End If key2 = InputBox("検索したい氏名2を入力してください。") If key2 = "" Then Else key3 = InputBox("検索したい氏名3を入力してください。") End If For i = 1 To 256 If ExecuteExcel4Macro(Target & "R1C" & i) = "名前" Then TargetCol = i Exit For End If Next i If TargetCol = 0 Then MsgBox "[ 名前 ]フィールドが見つかりません。", vbExclamation Exit Sub End If Dim clm As Integer For i = 2 To 10000 buf = ExecuteExcel4Macro(Target & "R" & i & "C" & Target If buf = "0" Then Exit For If buf = key1 Then Sheet3.Cells(w, 3) = buf w = w + 1 ReDim Preserve GetNames(i - 1) GetNames(i - 1) = buf ElseIf buf = key2 Then Sheet3.Cells(w, 3) = buf w = w + 1 ReDim Preserve GetNames(i - 1) GetNames(i - 1) = buf （略） -----------------
- 締切済み
- Visual Basic
- VBA 探しているFileがないときの処理方法
現在、下記のようにしてマクロ実行ブックと同じ階層のフォルダ名を取得してAに、フォルダ内のabc.XLSのC9の値をBに、abc.XLSの更新日時をCに表示させています。 このとき、フォルダ内にabc.XLSが無い場合にファイル名をAに書き出してB及びCは空白というように表示したいのですが、どのようにすればよろしいでしょうか。 macro1は以前質問させて頂いたものがベースになっています。ExecuteExcel4Macroを使っている関係でファイル名が無いときの処理はDirを使ってできるとmougで調べてわかりましたが、自分の知識ではできず、macro2を作成したのですが、指定ファイルがない場合の処理がうまくできずにいます。 macro1はファイルオープンの窓が開きます。macro2はファイルが存在しないという窓が開きます。 どちらの場合でもかまいませんのでお力をお貸し頂けませんでしょうか。 Sub macro1() Dim myPath As String Dim myFolder As String Dim r As Long r = 3 myPath = ThisWorkbook.Path & "\" myFolder = Dir(myPath, vbDirectory) myBook = "abc.XLS" Application.ScreenUpdating = False Range("A3:C60").Clear Do Until myFolder = "" If myFolder <> "." And myFolder <> ".." Then If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then Cells(r, 1) = myFolder Cells(r, 2).Value = ExecuteExcel4Macro("'" & myPath & myFolder & "\[" & myBook & "]Sheet1 '!R9C3") On Error Resume Next Cells(r, 3) = FileDateTime(myPath & myFolder & "\" & myBook) On Error GoTo 0 If Cells(r, 3) = "" Then Cells(r, 2) = "myBook" End If Cells(r, 2).NumberFormatLocal = "#,##0_ " Cells(r, 3).NumberFormatLocal = "y""年""m""月""" With Range("A3:C60") .Sort Key1:=Range("C3"), Order1:=xlAscending .Borders.LineStyle = True End With r = r + 1 End If End If myFolder = Dir() Loop Application.ScreenUpdating = True End Sub Sub Macro2() Dim myPath As String Dim myFolder As String Dim myBook As String myPath = ThisWorkbook.Path & "\" myFolder = Dir(myPath, vbDirectory) myBook = "abc.XLS" i = 2 Do Until myFolder = "" If myFolder <> "." And myFolder <> ".." Then If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then Workbooks.Open (myPath & myFolder & "\" & myBook) Range("C9").Activate Selection.Copy ThisWorkbook.Activate Cells(i, 1) = myFolder Cells(i, 2).PasteSpecial xlValues Cells(i, 3) = FileDateTime(myPath & myFolder & "\" & myBook) Workbooks(myBook).Close SaveChanges:=False i = i + 1 End If End If myFolder = Dir() Loop End Sub
- ベストアンサー
- Visual Basic
お礼
エラーも無くなり、できました。 ステップごとにやってみてどうやら("'\[meca.xls] あたりを疑って絶対パスに変更したら("'C:\[meca.xls]すんなりいきました。 お陰さまで大分勉強できてVBAの面白さも わかってきました。 ありがとうございました。