総ありがとう数 累計4,285万(2014年10月26日現在)

毎月4,000万人が利用!Q&Aでみんなで助け合い!

-PR-
noname#200395

こんにちは。よろしくお願いします。
あるフォルダ"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は範囲を読み込むことはできないのでしょうか?
何とかして処理速度を上げたいのですが、どうすればよいでしょうか。
  • 回答数3
  • 気になる数0

Aみんなの回答(全3件)

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

  • 2009-10-25 15:20:15
  • 回答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
お礼コメント
noname#200395

Wendy02さん
いつもありがとうございます。
mitarashiさんのご回答をいただいてから、「一旦配列に受けておいて、一気にセルに代入する」ためにいろいろ苦心していましたが、ついには捗のいかないまま、Wendy02さんのコードを拝借させていただく仕儀となりました。
実行結果についてひとつ申し添えますと、

    Loop While Dir() <> ""

のところは

Loop Until fn = ""

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

その他の回答 (全2件)

  • 2009-10-25 12:42:34
  • 回答No.1
最後の方の
.range(Cells(3, fc),cells(6, fc)) = e

e=.range(Cells(3, fc),cells(6, fc)) の間違いでしょうか?
eをvariantにしてはいかがですか
ExecuteExcel4Macroをなぜ使わなければならないのかよく解りません
>セルA3以下が読み込まれます。
とあるので単なる転記(代入)でいいと思いますが。
通報する
  • 同意数0(0-0)
  • ありがとう数0
  • 2009-10-25 13:20:09
  • 回答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
通報する
  • 同意数0(0-0)
  • ありがとう数0
  • 回答数3
  • 気になる数0
  • ありがとう数3
  • ありがとう
  • なるほど、役に立ったなど
    感じた思いを「ありがとう」で
    伝えてください

関連するQ&A

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

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

あなたの悩みをみんなに解決してもらいましょう

  • 質問する
  • 知りたいこと、悩んでいることを
    投稿してみましょう
-PR-
-PR-
-PR-

特集

専門医・味村先生からのアドバイスは必見です!

関連するQ&A

-PR-

ピックアップ

  • easy daisy部屋探し・家選びのヒントがいっぱい!

-PR-
ページ先頭へ