エクセル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

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2011/09/22 22:46:24
  • 終了:2011/09/29 22:50:03

ベストアンサー

id:Mook No.5

Mook回答回数1312ベストアンサー獲得回数3912011/09/23 15:01:41

ポイント20pt

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

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


こちらで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

その他の回答(4件)

id:Jupiter2100 No.1

じゅぴたー回答回数444ベストアンサー獲得回数742011/09/22 23:38:39

ポイント20pt

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


追記

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

  • ループ1:30ファイル・オープン
    • ループ2:64行の繰り返し
      • ループ3:65536行からMAX値を求める
  • ループ4:30ファイル分の繰り返し
    • ループ5:64行分のMAX値を代入

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

  • ループ1:30ファイル・オープン
    • ループ2:64行の繰り返し
      • ループ3:65536行からMAX値を求め,該当セルに代入する

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

id:pochi1234

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

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

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

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

2011/09/22 23:56:31
id:degucho No.2

degucho回答回数251ベストアンサー獲得回数662011/09/23 01:05:30

ポイント20pt

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

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

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

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

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

id:pochi1234

ご回答ありがとうございます。質問の趣旨と少し違うみたいなので

申し訳ないです。

2011/11/08 19:46:14
id:taknt No.3

きゃづみぃ回答回数13538ベストアンサー獲得回数11982011/09/23 01:27:44

ポイント20pt

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という範囲指定で値を

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

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


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

id:pochi1234

ご回答ありがとうございます。慣れていなかったので点を入れて忘れてました。

ループが難しかったですがなんとかできました。

2011/11/08 19:47:38
id:Jupiter2100 No.4

じゅぴたー回答回数444ベストアンサー獲得回数742011/09/23 02:12:24

ポイント20pt

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

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

id:Mook No.5

Mook回答回数1312ベストアンサー獲得回数3912011/09/23 15:01:41ここでベストアンサー

ポイント20pt

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

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


こちらで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

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません