• ベストアンサー

リストボックスにExecuteExcel4Macroで取得したデータを表示したいのですが

インターネットと参考書を利用して独学で仕事用VBAを作成している者です。 素人なりにいろいろ試してはいるのですがうまくいかないのでご教授願えたらと思い投稿しました。 質問は2つ+α で、 1.そもそも表題にあることが可能なのか?不可能なのか? 2.可能であるならどの辺りを修正したら良いのか? です。 +α というのは、恥ずかしながら具体的な提示です。 よろしくおねがいします。 Private Sub CommandButton3_Click() TextBox1 = Sheets("Sheet1").Range("A1").Value Dim DYear Dim mypath Dim dateFpath DYear = TextBox1.Text mypath = ActiveWorkbook.Path dateFpath = mypath & "\Date" & DYear ChDir mypath & "\Date" & DYear 'dateFpath 'カレントフォルダ Dim FCnt As Integer FCnt = 0 Dim dateName dateName = Dir(DYear & "証票*.xls") Dim sx As Long 'シートの列番号 ListBox1.ColumnCount = 6 '3列表示 ListBox1.ColumnWidths = "100 pt;35 pt;35 pt;35 pt;35 pt;35 pt;35 pt;35 pt;35 pt" '表示する列の幅 Dim nen nen = "年月日" Dim ji ji = "時" Dim fun fun = "分" Do While dateName <> "" FCnt = FCnt + 1 sx = 4 dateName = Dir() With ListBox1 .AddItem .List(FCnt, 0) = dateName '1列目 .List(FCnt, 1) = nen '2列目 sx = sx + 1 .List(FCnt, 2) = Application.ExecuteExcel4Macro("'" & dateFpath & "\[" & dateName & "]Sheet1'!R4C" & sx).Value '3列目 sx = sx + 1 .List(FCnt, 3) = Application.ExecuteExcel4Macro("'" & dateFpath & "\[" & dateName & "]Sheet1'!R4C" & sx).Value '4列目 sx = sx + 1 .List(FCnt, 4) = Application.ExecuteExcel4Macro("'" & dateFpath & "\[" & dateName & "]Sheet1'!R4C" & sx).Value '5列目 sx = sx + 2 .List(FCnt, 5) = Application.ExecuteExcel4Macro("'" & dateFpath & "\[" & dateName & "]Sheet1'!R4C" & sx).Value '6列目 sx = sx + 1 .List(FCnt, 6).Value = ji '7列目 .List(FCnt, 7) = Application.ExecuteExcel4Macro("'" & dateFpath & "\[" & dateName & "]Sheet1'!R2C" & sx).Value '8列目 sx = sx + 1 .List(FCnt, 8).Value = fun '9列目 End With Loop MsgBox FCnt & "個のデータが見つかりました" End Sub 以上です。 ループ1順目の3列目で停止してしまいます。 変数の値は確認しています。 よろしくお願いします。

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

  • ベストアンサー
  • onlyrom
  • ベストアンサー率59% (228/384)
回答No.2

一見しただけですが、基本的な間違いがいくつかあるようです。 '-------------------------------------------------- ●Application.ExecuteExcel4Macro の最後のVALUEは不要。 それが、 >ループ1順目の3列目で停止してしまいます。 の原因です。 ということは、4,5,6,8列目でもエラーがでるということです。 '-------------------------------------------------- ●dateName = Dir() の位置が違う >.List(FCnt, 8).Value = fun '9列目 >End With   ▲dateName = Dir() >Loop ▲の位置でないといけない 理由は実行してみれば分かります。 '------------------------------------------------   ●コードは9列まであるにも拘わらず、 >ListBox1.ColumnCount = 6  '3列表示 と、列は6に設定されている これも修正しておいた方がいいでしょう。 '------------------------------------------------- この3つを修正して実行してみてください。 そのうえでまだ疑問点があれば再質問のこと。 以上。  

zaki22
質問者

お礼

onlyrom様 ご回答ありがとうございます。 エラーで止まってしまうために 本当にいろいろ試しに試しすぎた結果このように余計なものがいろいろ付いてしまったと気が付きました。 が、ご指摘のとおりループが止まらずにとりあえず if dateName = "" exit sub end if こんなものを咬ませていたしだいです。 ありがとうございました。

その他の回答 (1)

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

>ExecuteExcel4Macro (1)ExecuteExcel4Macroを使う人が出てくるのは、エクセルの関数の中にそういう関数が無い場合にやむを得ずこれで回答する人が居る。 例 http://www.relief.jp/itnote/archives/001522.php ブック名を表示する-4.0マクロ関数 (2)ファイルを閉じたまま、データを取り出すこと、をしたい。 マクロは一種のプログラムですからMSが作ればなんとでもできるわけです。 http://okwave.jp/qa1120469.html に紹介の http://www.officetanaka.net/excel/vba/tips/tips28.htm http://homepage1.nifty.com/gak/MSTips/getfromclosedfile.html GoogleでExecuteExcel4Macroで紹介すれば相当数記事が出る。 ーー 本件は(2)の利用か? ブックを開いてはダメなのか? 4.0マクロは、きわどいものだと思うが。 ーーーー 忙しい回答者にこんな長いコードを解読させるのでなく、文章でポイントを表現した上で質問されることを希望する。 質問用に別途関係ない部分は省く例を作るぐらいの、気配りがほしい。エラーに関係ないこと、列挙型の複数繰り返しなど1つで良いではないですか。例 List(FCnt, 3) =以下3,4回の繰り返し >ループ1順目の3列目で停止してしまいます どこのことか探すのも大変。 どういうエラーコードかも参考に載せるべき。

zaki22
質問者

お礼

imogasi様 お忙しい中ありがとうございました。 回答の方を頂きながらも返事が遅くなったことをお詫び申しあげます。 (1)ブック名を表示することに関しては4マクロではなともできることは学ばせていただきました。リストボックスへ表示することもできるようになりました。そこで少し欲が出てしまったことに端を発します。 (2)初めはオープンブックでデータの抽出をしていました。 300近くあるブックブックを開いては閉じ、また開いては閉じを繰り返す時間は以外に長く”シートの検索”のように瞬間で終わるものとは雲泥の差(手作業に比べたら比較するほどの差はないのでしょうが)。 提示いただいたリンク先を見させていただきました。 >「ファイルを閉じたまま、データを取り出すこと」はこれ以外ないのか、載ってますね ​>http://www.officetanaka.net/excel/vba/tips/tips28.htm​ 開いたHPのなかの構文のなかの1行ですが  MsgBox ExecuteExcel4Macro("'C:\[Book1.xls]Sheet1'!R1C1")  これ↑が  MsgBox Application.ExecuteExcel4MacroExecuteExcel4Macro("'C:\[Book1.xls]Sheet1'!R1C1")  これ↑とが どう違うのかは勉強不足でわかりません。  それと Sub Test() For i = 1 To 900  Range("A" & i).Value = _     "='" & ThisWorkbook.Path & _     "\[Book" & i & ".xls]Sheet1'!B3"  Range("A" & i).Value = Range("A" & i).Value Next i End Sub 上記のものも途中の文は結局は'C:\[Book1.xls]Sheet1'!R1C3")こんな感じで(イコールが被っているのが理解できませんが)4マクロ以前の文字があるかないか程度の違いしかわかりません。 ついでに付け足させていただくと、 >4.0マクロ関数じゃないけど、似たような処理の回答をさっきもしました。 という内容に、 q = " '" & DrPh & "\[" & s & "]sheet1'!" & ITI Da = Application.ExecuteExcel4Macro(q) こんなものもありました。 これらは結局4マクロではないんですか?理解に苦しみます。

関連するQ&A

  • ExecuteExcel4Macroでセル値取得

    office2010 あるフォルダにファイルを入れて、ファイルを開かずに対象シートの対象セルの値を取得したいです。 この取得したいセル情報を、変数で指定したいのです。 C:\dataに取得元のファイルが入っています。 このファイル名((1))は、いろいろ変わりますが、中にH4という文字があります。 対象シートのシート名とセルアドレスは、別のファイル(これにマクロがあります) のsettingシートで指定します。 1例ですが、settingシートの B2に11_001 C2にAF9 と設定します。 (1)のファイルで11_001というシートのAF9セル値を取得したいのです。 Dim myPath As String Dim myFile As String myPath = "C:\data\" myFile = Dir(myPath & "*H4*.xlsm") Dim sheetname As String Dim cell As String sheetname = Worksheets("setting").Range("B2") cell = Worksheets("setting").Range("C2").Value ' 'Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!R9C32") Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!" & cell & "") 上記で、 Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!R9C32") は、値取得できます。 このR9C32を変数にする所で、エラーが発生します。 実行時エラー1004と。 いろいろWEB見て、’,スペース等を入れてみましたが、どうしても分からず、 Range("A1") = ExecuteExcel4Macro("'[" & myFile & "]" & sheetname & "'!" & cell & "") の最後のセル指定を、変数で設定する方法を教えて頂きたく。

  • Application.ExecuteExcel4Macroなに?

    No.373903を拝見しまして、閉じたままのブックを参照できるらしいので使いたいのですが、ブックが複数ある場合、[ ]内はどのように書けば良いのでしょう? 例) Cells(1, 1) = Application.ExecuteExcel4Macro _ ("'C:\My Documents\[Book2.xls]Sheet1'!R1C1") Book2・sheet1の部分が可変。 また、 Application.ExecuteExcel4Macro("get.document(50)") や Application.ExecuteExcel4Macro ("Halt(True)") 等の使い方もあるようですが、どなたかわかりやすく教えて頂けませんか?

  • ExecuteExcel4Macroでのデータ取得

    office365 従来、ドメイン配下のサーバに登録されているファイルをExecuteExcel4Macroでファイルを開かずにセルの値を抽出していました。 今回、サーバがドメイン配下でなくなったので参照ツールを変更しようとしています。 サーバ名が○○○○ IDがID パスワードがPW で Gドライブのinフォルダに登録されてる ファイル名:A001.xslsm シート名 :1_001_01 セルアドレス:A1 の内容を refer.xslmファイルのセルアドレスR1にExecuteExcel4Macroで表示させるマクロをベタで教えていただきたく。 ExecuteExcel4Macroでデータ抽出する構成にしているのは、参照するファイル容量が大きいので、 ファイルを開いてコピペ方式だとレスポンスが悪いからです。 サーバにはリモートディスクトップ接続をバッチファイルで起動したら入れる様にはなってます。 kido.batの中身 @echo off Set SERVER=○○○○ Set USERNAME=ID Set PASSWORD=PW Cmdkey /generic:TERMSRV/%SERVER% /user:%USERNAME% /pass:%PASSWORD% Start mstsc /v:%SERVER% Timeout 3 Cmdkey /delete:TERMSRV/%SERVER% kido.batを起動するマクロは下記 Sub RunBatShell() Dim dProcessId As Double Dim sPath sPath = "C:\Users\ID\Desktop\kido.bat" dProcessId = Shell(sPath) End Sub 上記バッチ内容もマクロに記述出来たら1本化したく。

  • リストボックスについて

    リストボックスからデータを転記したいのですが、 実行時エラー"1004"が出てしまい、どうしてもうまくいきません。 どなたか原因を教えてください。 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim i As Long With Worksheets("sheet2") i = .Range("F47").End(xlUp).Row + 1 .Range(i, 6).Value = ListBox1.List(ListBox1.ListIndex, 0) .Range(i, 12).Value = ListBox1.List(ListBox1.ListIndex, 1) .Range(i, 26).Value = ListBox1.List(ListBox1.ListIndex, 2) .Range(i, 28).Value = ListBox1.List(ListBox1.ListIndex, 3) .Range(i, 34).Value = ListBox1.List(ListBox1.ListIndex, 4) .Range(i, 37).Value = ListBox1.List(ListBox1.ListIndex, 5) End With Unload Me End Sub

  • Excel VBA ExecuteExcel4Macroについて

    こんにちは。よろしくお願いします。 あるフォルダ"D:\test"のなかに、4つのxlsファイル"o.xls"、"a.xls"、"b.xls"、"c.xls"があるとします。 使用するシート名は、それぞれo,a,b,c(ファイル名から".xls"を除いたもの)とします。 このとき"o.xls"を開いて、下記のマクロを実行すると、1行目にパス名、2行名にファイル名、3行目以下に(1列目は"a.xls"の、2列目は"b.xls"の、3列目は"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ファイルも3つしかありませんのですぐに終わりますが、実際には行やファイルがもっとたくさんあり、非常に時間がかかっています。そこで、 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は範囲を読み込むことはできないのでしょうか? 何とかして処理速度を上げたいのですが、どうすればよいでしょうか。

  • ExecuteExcel4Macroを使ったレコードの読み込み方法につ

    ExecuteExcel4Macroを使ったレコードの読み込み方法について 下記サンプルは、ファイルを指定して、指定したファイルの中にあるシートを選択し、その中にあるデータを読込むものになっています。 読込ませるファイルのsheet1には、『 ID,顧客番号,氏名,住所,電話番号 』 が入っています。 下記サンプルでは、顧客番号フィールドのデータは読込めるのですが、該当するレコード全体を読込むにはどう組み立てればいいかよくわかりません。 すみませんが、どなたかご教授いただけませんでしょうか。よろしくお願いいたします。 Public Sub testes() ' 変数の指定 Dim OpenFileName, SheetName, Target, buf As String Dim i, TargetCol As Long, GetNames() ' 対象ブックの選択 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 ' [顧客番号]フィールドを探す 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 ' データの読み込み For i = 1 To 10000 buf = ExecuteExcel4Macro(Target & "R" & i) If buf = "0" Then Exit For ' シートに出力する Worksheets("sheet3").Activate ActiveSheet.Cells(i, 1) = buf Next i End Sub

  • リストボックスから複数行を選択し、その複数のデータをセルに入力したい

    Excel2003でマクロをつくっています。シートのB列を右クリックすると、リストボックスが表示され 任意1行を選択するとシートのB列、C列、D列のセルにデーターが入力されます。 Private Sub ListBox2_Click() With ListBox2 If .ListIndex = -1 Then MsgBox "項目を選択してくだい" Else ’シートが保護されていたら保護を解除 If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect End If ActiveCell.Value = ListBox2.List(ListBox2.ListIndex, 0) ActiveCell.Offset(0, 1).Value = ListBox2.List(ListBox2.ListIndex, 1) ActiveCell.Offset(0, 2).Value = ListBox2.List(ListBox2.ListIndex, 2) ActiveSheet.Protect End If End With Unload UserForm3 End Sub このリストボックスから複数の行を選択し、シートのB列、C列、D列のセルにデーターを入力したいのですが、Multiselectプロパティを変更しても、一行のみしか入力できません。 上のコードをどうかえたらよろしいでしょうか。

  • VBAでのExecuteExcel4Macroの値取得でエラー

    こんにちは。 Excel VBAより、ExecuteExcel4Macroを実行して、 外部のExcelファイルの、名前(店名、月度)を定義したセルの値を取得したいと思っています。 店名:文字列型 月度:Date型 そこで、ExecuteExcel4Macro()を実行し、以下のような処理を加えました。 ------------------------------------------------------------------------------------ dim 店名 as Variant, 月度 as Variant If 外部マクロ実行("'c:\[test.xls]出勤簿'!店名", 店名) = False Or _ 外部マクロ実行("'c:\[test.xls]出勤簿'!月度", 月度) = False Then MsgBox "取得失敗", vbExclamation End End If Public Function 外部マクロ実行(com As String, ByRef result As Variant) As Boolean On Error GoTo erron3 result = ExecuteExcel4Macro(com) On Error GoTo 0 外部マクロ実行 = True Exit Function erron3: 外部マクロ実行 = False End Function ------------------------------------------------------------------------------------ これを実行したところ、「月度」の値は取得できるのですが、 「店名」の値には「エラー 2042」という値が入ります。 ※dirname, filenameは正しい値が入っています。 ※シート「出勤簿」および「月度」「店名」のセル名の定義も存在します。 test.xlsを開いてるときは、上記の現象は起こらず、 「店名」の値は正常に取得できます。 また、試しに、test.xlsを開き、 Worksheets("出勤簿").Range("店名")を実行すると、正常な値が取得できました。 まとめると、 ・閉じたブックの、あるシートにある、セルに定義された名前を指定して ・ExecuteExcel4Macroで、文字列が入っている値を取得しようとした時、 ・正常に値が取得できない という現象に遭遇しています。 3日ほど調べているのですが、どうしても原因が分かりません。 解決策をお持ちの方、いらっしゃいましたらアドバイスを頂けると助かります。 環境:WindowsXP Pro SP3 Excel 2003 (11.5612.5606) 以上、よろしくお願いいたします。

  • Excel VBA でExecuteExcel4Macro("GET.OBJECT(48,

    エクセル2000です。 以前、ワークシートに配置したフォームツールのラベルの参照元を取得するマクロをご教示いただき、以下のTest01は問題なく作動しています。 Sub test01() Dim obj As Object Dim i As Integer Dim obj_n As String 'オブジェクトの名前 With ActiveSheet For Each obj In .Labels i = i + 1 .Cells(i, 2) = obj.Name: obj_n = obj.Name .Cells(i, 3) = obj.TopLeftCell.Address 'GET.OBJECT で、リンクがないものを取ると、False になる .Cells(i, 5) = ExecuteExcel4Macro("GET.OBJECT(48,""" & obj_n & """)") .Cells(i, 6) = obj.OnAction Next End With End Sub 今回、同一シートではなく別シートに表示させようと以下のTest02を書いたのですが、やってみると .Cells(i, 5) はすべて#VALUE!エラーになってしまいました。 ExecuteExcel4Macro("GET.OBJECT(48~がどのようなものかわからずやっているので応用がききません。(そもそも48って?) どのようになおしたらよいのかご教示いただければ幸いです。 Sub test02() Dim obj As Object Dim i As Integer Dim obj_n As String Dim ws As Worksheet, ns As Worksheet Set ws = ActiveSheet Set ns = Worksheets.Add With ns For Each obj In ws.Labels i = i + 1 .Cells(i, 2) = obj.Name: obj_n = obj.Name .Cells(i, 3) = obj.TopLeftCell.Address .Cells(i, 5) = ExecuteExcel4Macro("GET.OBJECT(48,""" & obj_n & """)") .Cells(i, 6) = obj.OnAction Next End With End Sub

  • リストボックスで選択した項目に該当するデーターをラベルに表示する

    よろしくお願いします ユーザーフォームにリストボックスが2つ ラベルが1つ 配置しています。 リストボックス1で選択した項目に該当するリストを リストボックス2に表示する。 次に リストボックス2で選択した項目に該当するデーターを ワークシートのセル(E5:E300)から選んで ラベル1に表示する。 このようにしたいのですがエラーが出ます。 Dim LastRow As Long Dim DstRow As Long Const FstRow As Long = 5 Dim MctRow As Long   -  -  - Private Sub UserForm_Initialize() With Me.ListBox1 .RowSource = Worksheets("入力").Range("A5:A300").Address(External:=True) End With End Sub   -  -  - Private Sub ListBox1_Click() Dim j As Integer Dim RowCnt As Long With Worksheets("入力") LastRow = .Range("E300").End(xlUp).Row ListBox2.Clear For RowCnt = 5 To LastRow If ListBox1.List(ListBox1.ListIndex) = .Cells(RowCnt, 3).Value Then ListBox2.AddItem For j = 0 To 1 ListBox2.List(ListBox2.ListCount - 1, j) = .Cells(RowCnt,5 + j).Value Next j End If Next RowCnt End With End Sub   -  -  - Private Sub ListBox2_Click() Dim SrcCode As Long SrcCode = ListBox2.List(ListBox2.ListIndex, 0)     ↑    ↑    ↑ ここでエラーになります。 実行時エラー 型が一致しません と表示されます With Worksheets("入力") LastRow = .Range("E300").End(xlUp).Row MctRow = Application.WorksheetFunction.Match(SrcCode, .Range("E5:E" & LastRow), 0) + 5 Label1 = Format(.Cells(MctRow, 5)) End With End Sub

専門家に質問してみよう