解決済みの質問

質問No.5394808
暇なときにでも
暇なときにでも
お気に入り投稿に追加する (0人が追加しました)
回答数3
閲覧数2958
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は範囲を読み込むことはできないのでしょうか?
何とかして処理速度を上げたいのですが、どうすればよいでしょうか。
投稿日時 - 2009-10-25 11:01:38

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

回答No.3
こんにちは。

mitarashiさん、どうもありがとうございます。
今回の件については、私のコードは苦肉の策の内容のようです。

>ExecuteExcel4Macroは範囲を読み込むことはできないのでしょうか?

今回のコードも、INDEX関数で取ることはできないわけではないのですが、本質的には、一つずつ取り出すしかないようですね。

なお、ExecuteExcel4Macroを使うと、使うメリットは、ファイルを開かなくて済むということですが、DAOやADOの方法もあります。開くときのオーバーヘッドが減らせますから、ファイルの数が多ければ多いほど、時間は少なくて済むはすだと思います。

以下のコードは、値自体のエラー値や'0'を取り去ることも出来ませんが、同じ技法を使った、Consolidate という方法があります。少しは、速くなるような気がします。

なお、以下のコードの細かい点は検証されていません。
'-------------------------------------------

Sub TestMacro1()
  Dim p As String
  Dim fn As String
  Dim j As Long
  Const EXT As String = ".xls" '拡張子
  Application.Calculation = xlManual
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  p = Application.DefaultFilePath
  
  With Worksheets("o")
    .UsedRange.Clear
    fn = Dir(p & "\" & "*.xls", vbNormal)
    
    Do
      .Cells(1, j + 1).Value = p & "\" & fn
      .Cells(2, j + 1).Value = fn
      
      .Range("A3").Resize(4).Offset(, j).Consolidate Sources:= _
      "'" & p & "\[" & fn & "]" & Replace(fn, EXT, "", 1) & "'!R3C1:R6C1", _
      Function:=xlSum, TopRow:=True, LeftColumn:=False, CreateLinks:=False
      j = j + 1
      fn = Dir()
    Loop While Dir() <> ""
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Application.Calculation = xlAutomatic
End Sub
投稿日時 - 2009-10-25 15:20:15
この回答を支持する
(現在1人が支持しています)
お礼
Wendy02さん
いつもありがとうございます。
mitarashiさんのご回答をいただいてから、「一旦配列に受けておいて、一気にセルに代入する」ためにいろいろ苦心していましたが、ついには捗のいかないまま、Wendy02さんのコードを拝借させていただく仕儀となりました。
実行結果についてひとつ申し添えますと、

    Loop While Dir() <> ""

のところは

Loop Until fn = ""

にさせていただきました。
もちろん"o.xls"の情報をもういちどD列に書き出す必要などないのですが、前者のままだとなぜか"c.xls"のデータが読み込まれなかったからです。
とにかく、大変感謝しております。ありがとうございました。
投稿日時 - 2009-10-25 16:21:52

ベストアンサー以外の回答 (2)

回答No.2
範囲で読み込んでいる例を見たことがないので、出来ないのかもしれません。(確証なし)
下記に、本板の常連のWendy02さんの回答例があります。
http://oshiete1.goo.ne.jp/qa2999291.html
試してみた結果では、一旦variant型の配列に値を収納しておいて、範囲に代入するところが高速化に効いている様でした。
データ数が増えてくると、ご呈示のコードの
.Cells(i, fc) = e
のところを、一旦配列に受けておいて、一気にセルに代入するのは高速化に相当効きます。(5年くらい前のCeleron機で、1000個のデータ読込・転写が6.6秒位でしたが、どうでしょうか)
http://officetanaka.net/excel/vba/speed/s11.htm
投稿日時 - 2009-10-25 13:20:09
この回答を支持する
(現在1人が支持しています)
回答No.1
最後の方の
.range(Cells(3, fc),cells(6, fc)) = e

e=.range(Cells(3, fc),cells(6, fc)) の間違いでしょうか?
eをvariantにしてはいかがですか
ExecuteExcel4Macroをなぜ使わなければならないのかよく解りません
>セルA3以下が読み込まれます。
とあるので単なる転記(代入)でいいと思いますが。
投稿日時 - 2009-10-25 12:42:34
この回答を支持する
(現在0人が支持しています)
この質問は役に立ちましたか?
3人が「このQ&Aが役に立った」と投票しています
もっと聞いてみる

関連するQ&A

この他の関連するQ&Aをキーワードで探す

別のキーワードで再検索する

関連するガイド記事

    回答募集中

    同じカテゴリの人気Q&Aランキング

    カテゴリ
    その他MS Office
    -PR-

    OKWaveのおすすめ情報

    特集

    このQ&Aの関連キーワード

    同じカテゴリの人気Q&Aランキング

    カテゴリ
    その他MS Office
    -PR-

    ピックアップ

    -PR-
    -PR-