人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルVBAについて質問です。【良回答500ポイント】
30個ぐらいあるファイルから Range("E27, BI65536")の各列のMax値を取得して、別のワークブックに転記する方法を探しています。Max値の取得はマクロ側で行い、転記は一括で行います。
何か効率の良い書き方や他の方法があれば教えて頂きたいです。また、配列を使う場合、rangeに出力するにはどんな書き方が効率が良いでしょうか?
よろしくお願い致します。

※下記コードは書きかけで申し訳ないです。文字数の関係で、画面更新等の停止は省略しています。

Sub main()
Dim strDataRange As String
Dim strPostRange As String
Dim dataPath As String
Dim dataFile As String
Dim objWorkbook As Workbook
Dim dataMax() As Double

strDataRange = "B4:BI65536"
dataPath = ThisWorkbook.Path & "\data\"
dataFile = Dir(dataPath & "*.xls")

Do
Set objWorkbook = Workbooks.Open(dataPath & "\" & dataFile)

'各列のMax値の取得、dataMax(i, j)でループ処理するか、他の方法で

objWorkbook.Close (False)
dataFile = Dir
Loop While MyFile <> ""

'ここに転記予定 ThisWorkbook.Sheets(2).Range(H14:AZ55).Value

Set objWorkbook = Nothing
End Sub


●質問者: pochi1234
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 5/5件

▽最新の回答へ

1 ● じゅぴたー
●20ポイント

一括転記しないでMAX値を計算するたびに逐次転記した方が、配列を経由することがなく効率的だと思うのですが、いかがでしょう。


追記

各ファイルの各列についてMAXを求め、配列に格納するなどして、一括してMAX値を格納するには次のような5つのループを必要とします。

一方、逐次代入するなら、以下の3つのループで済みます。

このことから、逐次代入の方が処理的に速くなることが予想されます。

◎質問者からの返答

ご回答ありがとうございます。

おっしゃられるように一括転記しないでMAX値を計算するたびに転記したほうがコードが簡単になりそうですが、

データが65536行×64行×30ファイル程度あり、

処理速度は体感でも、逐次転記と変わらないでしょうか?


2 ● degucho
●20ポイント

・MAXはどっか適当なセルに式を入れて結果を取得したほうが早いと思います

・転記は配列に入れといて貼付けると早いです

http://www.happy2-island.com/excelsmile/smile03/capter01105.shtml

・30シートくらいなら新規ブックに該当ブックのシートを

全部コピーして式を入れれば済むような...


pochi1234さんのコメント
ご回答ありがとうございます。質問の趣旨と少し違うみたいなので 申し訳ないです。

3 ● きゃづみぃ
●20ポイント

MAX値は 簡単に取得できますので それを 直接 セルに入れたほうが

処理もわかりやすいし、配列に入れる分だけ(ほんのわずかですが) 速いと思われます。


Range("E27, BI65536")

これだと ちょっと 範囲が わかりにくいのですが

E列からBI列まで27行から65536まであるということでしょうか?

E列は 5番目なので

b = Application.WorksheetFunction.Max(Range(Cells(27, 5), Cells(65536, 5)))

で MAX値が求まります。

これを ループさせて BI列まで取得すればいいでしょう。


あと

'ここに転記予定 ThisWorkbook.Sheets(2).Range(H14:AZ55).Value

とありますが

ま、これは イメージかとは 思いますが、H14:AZ55という範囲指定で値を

セットは できないですね。

ひとつひとつのセルの位置を指定しないと セットできません。


だから 配列分ループが必要となってしまうので、取得した際にセットしたほうがいいでしょう。


pochi1234さんのコメント
ご回答ありがとうございます。慣れていなかったので点を入れて忘れてました。 ループが難しかったですがなんとかできました。

4 ● じゅぴたー
●20ポイント

返信コメントをありがとうございます。

処理速度についてNo.1の回答に追記しました。


5 ● Mook
●20ポイント ベストアンサー

この作業では一番時間がかかるのはファイルの読み込みなので、配列を使う

使わないの影響はほとんどありません。


こちらでE27:BI65536 にフルにデータを入れたファイル(1ファイル25 Mbyte)を

30個で実行した時間は配列で24秒、セルに直接で25秒でほとんど誤差範囲ですね。

計測できたほとんどすべての時間がファイル読み込み時間で、セルの記入は

1秒以下でした。


ファイルサイズがそれほど大きくなければ、データを1ファイルにまとめて

しまうのが一番時間的な効率改善である気がします。



Option Explicit

Sub getMaxDataArray()
 Const strDataRange = "E27:BI65536"
 
 Dim maxDataArray(1 To 30, 1 To 57)
 Dim dataPath As String
 dataPath = ThisWorkbook.Path & "\data\"
 
 Dim dstRow As Long
 dstRow = 1
 
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Dim dataFile As String
 dataFile = Dir(dataPath & "*.xls")
 
 Dim r As Range
 Do While dataFile <> ""
 If dstRow > 30 Then
 MsgBox "配列のサイズが足りません。"
 Exit Do
 End If
 
 With Workbooks.Open(dataPath & dataFile)
 For Each r In .Worksheets(1).Range("E27:BI27")
 maxDataArray(dstRow, r.Column - 4) = Application.Max(r.Resize(65510, 1))
 Next
 .Close
 End With
 dataFile = Dir
 dstRow = dstRow + 1
 Loop
 
 ThisWorkbook.Sheets(2).Range("H14").Resize(UBound(maxDataArray, 1), UBound(maxDataArray, 2)) = maxDataArray
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
End Sub

Option Explicit

Sub getMaxDataCell()
 Const strDataRange = "E27:BI65536"
 
 Dim dataPath As String
 dataPath = ThisWorkbook.Path & "\data\"
 
 Dim dstRow As Long
 
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Dim dataFile As String
 dataFile = Dir(dataPath & "*.xls")
 
 Dim r As Range
 Do While dataFile <> ""
 
 With Workbooks.Open(dataPath & dataFile)
 For Each r In .Worksheets(1).Range("E27:BI27")
 ThisWorkbook.Worksheets(2).Range("H14").Offset(dstRow, r.Column - 5).Value = Application.Max(r.Resize(65510, 1))
 Next
 .Close
 End With
 dataFile = Dir
 dstRow = dstRow + 1
 Loop
 
 Application.DisplayAlerts = True
 Application.ScreenUpdating = True
End Sub
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ