こんにちは。よろしくお願いします。
あるフォルダ"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は範囲を読み込むことはできないのでしょうか?
何とかして処理速度を上げたいのですが、どうすればよいでしょうか。
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
Wendy02さん
いつもありがとうございます。
mitarashiさんのご回答をいただいてから、「一旦配列に受けておいて、一気にセルに代入する」ためにいろいろ苦心していましたが、ついには捗のいかないまま、Wendy02さんのコードを拝借させていただく仕儀となりました。
実行結果についてひとつ申し添えますと、
Loop While Dir() <> ""
のところは
Loop Until fn = ""
にさせていただきました。
もちろん"o.xls"の情報をもういちどD列に書き出す必要などないのですが、前者のままだとなぜか"c.xls"のデータが読み込まれなかったからです。
とにかく、大変感謝しております。ありがとうございました。
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
No.1
- 回答日時:
最後の方の
.range(Cells(3, fc),cells(6, fc)) = e
は
e=.range(Cells(3, fc),cells(6, fc)) の間違いでしょうか?
eをvariantにしてはいかがですか
ExecuteExcel4Macroをなぜ使わなければならないのかよく解りません
>セルA3以下が読み込まれます。
とあるので単なる転記(代入)でいいと思いますが。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) マクロのコードを、少しでも削って短くしたい 3 2022/08/30 07:46
- Visual Basic(VBA) 【マクロ】フォルダにファイルが1つも無い時に、ファイルがありませんとメッセージを表示する 4 2022/08/28 08:48
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
- Excel(エクセル) Excel VBAどこが間違ってますか? 4 2023/07/17 10:04
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
このQ&Aを見た人はこんなQ&Aも見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
VBA ExecuteExcel4Macro 型が一致しません
Excel(エクセル)
-
ファイルを閉じたままの外部参照で最終行の行数取得
Visual Basic(VBA)
-
VBScriptによるExecuteExcel4Macroの使い方について
Visual Basic(VBA)
-
-
4
Excel VBAのApplication.ExecuteExcel4Macro
Access(アクセス)
-
5
VBA ブックを開かずにブック内のデータを取得する方法
Visual Basic(VBA)
-
6
別ファイルを開かず、INDIRECT関数を使用せずに、別ファイルのデータを求めたい
Excel(エクセル)
-
7
Excel VBA:フォーム←→セルのアクティブ切り替え
Excel(エクセル)
-
8
VBAでのExecuteExcel4Macroの値取得でエラー
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
男の人はやってるとき 彼女がす...
-
彼と体の相性が良すぎて悩んで...
-
女性が喘いでいるときの男性の...
-
高校生です。彼氏の前で初めて...
-
夫婦の夜の営みについてです。 ...
-
彼女が感じやすくて可愛い
-
抱きしめたときに勃起したあそ...
-
男性の方に質問です。 バックで...
-
男の人ってなんですぐ勃つの?...
-
もし週1しか恋人と会えなかった...
-
クンニしたことある人ー ま○こ...
-
キスすれば相手を好きでなくて...
-
彼氏と毎日セックスするのは異...
-
彼氏のセックスが下手すぎで幻...
-
実家住まいの場合Hはホテル以外...
-
ふぇらでイカセテくれる うまい...
-
初体験って気持ちいいの? 男の...
-
彼女がフェラをしてくれません。
-
兄妹や姉弟で、キスやエッチし...
-
男性に質問です! 電話だけで勃...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
男の人はやってるとき 彼女がす...
-
彼と体の相性が良すぎて悩んで...
-
女性が喘いでいるときの男性の...
-
高校生です。彼氏の前で初めて...
-
夫婦の夜の営みについてです。 ...
-
彼氏と毎日セックスするのは異...
-
男性の方に質問です。 バックで...
-
抱きしめたときに勃起したあそ...
-
彼女が感じやすくて可愛い
-
もし週1しか恋人と会えなかった...
-
男の人ってなんですぐ勃つの?...
-
クンニしたことある人ー ま○こ...
-
ふぇらでイカセテくれる うまい...
-
彼氏のセックスが下手すぎで幻...
-
キスすれば相手を好きでなくて...
-
実家住まいの場合Hはホテル以外...
-
兄妹や姉弟で、キスやエッチし...
-
彼女がフェラをしてくれません。
-
男性に質問です! 電話だけで勃...
-
SEXの相性が良すぎると男はダメ...
おすすめ情報