エクセルで１００以上のシートからデータを読み込むのに時間がかかり困っています

質問

エクセル２００３でAuto_Open時にデータの更新をしてみましたが、一々画面を読んでしまい時間がかかってしまいます。
まだコードがよく理解できていませんので、どなたかよい方法を教えてください。
コードは以下のようです。
シートは１８０あり、一覧表にシート名の表を作りました。
よろしくお願いします。

Sub Auto_Open()
'シートオープンで一覧表のデータ更新
'変数の宣言
Dim MyDA As Integer
Dim MyDB As String
Dim MyDC As String
Dim MyDD As String
Dim MyDE As String
Dim MyDF As String
Dim MyDG As String
Dim MyDH As String
Dim MyDI As String
Dim MyDJ As String
Dim MyDK As String

For MyDA = 3 To 173

'一覧表を呼びシート名の代入
Worksheets("一覧表").Activate
MyDB = Range("T" & MyDA).Value

'必要なデータの代入
Worksheets(MyDB).Activate
MyDC = Range("J3").Value
MyDD = Range("J4").Value
MyDE = Range("B6").Value
MyDF = Range("F6").Value
MyDG = Range("K6").Value
MyDH = Range("C9").Value
MyDI = Range("B8").Value
If MyDI = "" Then
MyDI = "-"
End If
MyDJ = Range("F8").Value
If MyDJ = "" Then
MyDJ = "-"
End If
MyDK = Range("K8").Value
If MyDK = "" Then
MyDK = "-"
End If

Sheets("一覧表").Activate
Range("B" & MyDA) = MyDC
Range("C" & MyDA) = MyDD
Range("D" & MyDA) = MyDE
Range("E" & MyDA) = MyDF
Range("F" & MyDA) = MyDG
Range("G" & MyDA) = MyDH
Range("H" & MyDA) = MyDI
Range("I" & MyDA) = MyDJ
Range("J" & MyDA) = MyDK

Next MyDA

End Sub

回答No.2

end-u · ベストアンサー

配列変数について覚えると、速く処理できるようになります。

Dim i As Long
Dim n As Long
Dim v, x

With Sheets("一覧表")
　　x = .Range("T3", .Cells(.Rows.Count, "T").End(xlUp)).Value
End With
n = UBound(x)
ReDim v(1 To n, 1 To 9)
For i = 1 To n
　　With Sheets(x(i, 1))
　　　　v(i, 1) = .Range("J3").Value
　　　　v(i, 2) = .Range("J4").Value
　　　　v(i, 3) = .Range("B6").Value
　　　　v(i, 4) = .Range("F6").Value
　　　　v(i, 5) = .Range("K6").Value
　　　　v(i, 6) = .Range("C9").Value
　　　　v(i, 7) = .Range("B8").Value
　　　　v(i, 8) = .Range("F8").Value
　　　　v(i, 9) = .Range("K8").Value
　　　　If v(i, 7) = "" Then v(i, 7) = "-"
　　　　If v(i, 8) = "" Then v(i, 8) = "-"
　　　　If v(i, 9) = "" Then v(i, 9) = "-"
　　End With
Next
With Sheets("一覧表").Range("B3:J3").Resize(n)
　　.ClearContents
　　.Value = v
End With
Erase v

こんな感じになります。

自分が理解できる範囲で、工夫次第でシンプルに処理できる場合もあります。
例えばT列のシート名をINDIRECT関数で参照する方法も考えられます。

Const f = "INDIRECT(""'""&T3&""'!"
Dim n As Long

With Application
　　.ScreenUpdating = False
　　.EnableEvents = False
End With
With Sheets("一覧表")
　　n = .Cells(.Rows.Count, "T").End(xlUp).Row
　　With .Range("B3:J" & n)
　　　　'=INDIRECT("'"&T3&"'!J3")みたいな式を入れる
　　　　.Columns(1).Formula = "=" & f & "J3"")"
　　　　.Columns(2).Formula = "=" & f & "J4"")"
　　　　.Columns(3).Formula = "=" & f & "B6"")"
　　　　.Columns(4).Formula = "=" & f & "F6"")"
　　　　.Columns(5).Formula = "=" & f & "K6"")"
　　　　.Columns(6).Formula = "=" & f & "C9"")"
　　　　.Columns(7).Formula = "=IF(" & f & "B8"")="""",""-""," & f & "B8""))"
　　　　.Columns(8).Formula = "=IF(" & f & "F8"")="""",""-""," & f & "F8""))"
　　　　.Columns(9).Formula = "=IF(" & f & "K8"")="""",""-""," & f & "K8""))"
　　　　'値化
　　　　.Value = .Value
　　End With
End With
With Application
　　.EnableEvents = True
　　.ScreenUpdating = True
End With

意外と速いです。

お礼

end-u様
回答ありがとうございました。
処理方法はいろいろあるものなのですね。
それぞれに試させていただきます。
実に速くて私には満足にいくものばかりでした。
ありがとうございました。
それで時間がありましたら下の(1)～(3)の疑問点を教えていただけないでしょうか。
よろしくお願いします。

Dim i As Long
Dim n As Long
Dim v, x

With Sheets("一覧表")
x = .Range("T3", .Cells(.Rows.Count, "T").End(xlUp)).Value

【(1)　ｘ　にはシート名（T　列のデータ）を全部入れているのですか？】

End With
n = UBound(x)　
ReDim v(1 To n, 1 To 9)

【(2)　ReDimでの説明と、ｖ　には全部のデータが入るのか教えてください？】

For i = 1 To n
　　With Sheets(x(i, 1))
　　　　v(i, 1) = .Range("J3").Value
　　　　v(i, 2) = .Range("J4").Value
　　　　v(i, 3) = .Range("B6").Value
　　　　v(i, 4) = .Range("F6").Value
　　　　v(i, 5) = .Range("K6").Value
　　　　v(i, 6) = .Range("C9").Value
　　　　v(i, 7) = .Range("B8").Value
　　　　v(i, 8) = .Range("F8").Value
　　　　v(i, 9) = .Range("K8").Value
　　　　If v(i, 7) = "" Then v(i, 7) = "-"
　　　　If v(i, 8) = "" Then v(i, 8) = "-"
　　　　If v(i, 9) = "" Then v(i, 9) = "-"
　　End With
Next
With Sheets("一覧表").Range("B3:J3").Resize(n)
　　.ClearContents

　　.Value = v　
【(3)　これだけですべてのデータが一覧表に入るのですか？入れるデータの範囲指定の方法の説明をお願いします。】

End With
Erase v

回答No.4

end-u

>【(1)　ｘ　にはシート名（T　列のデータ）を全部入れているのですか？】

はい。
.Range("T3", .Cells(.Rows.Count, "T").End(xlUp))は解りますね。
.Rows.Countはシートの最大行数。2003以前は65,536行。
.Cells(.Rows.Count, "T")はT65536セルです。
.Cells(.Rows.Count, "T").End(xlUp)とは、T65536セル選択し[Ctrl]+[↑]キーを押した時に止まるセルです。
∴T3セルからT列最終データセルまでの範囲を指定している事になります。

>Dim v, x
これはちゃんと書くと
Dim v As Variant
Dim x As Variant
です。

Variant型変数に　x = Range(複数範囲).Value　などのようにセル複数範囲の値を入れると２次元配列になります。
この時、配列のインデックスは１から始まります。
２次元配列に関しては、メモリ上にあるセル範囲のようなものを想像してください。
今回の場合は、x(1, 1)にT3セルの値が入ってますし、x(2, 1)にT4セルの値が入っています。
この時の(1, 1)というのがアドレスみたいなもので、それによって配列（メモリ上の矩形範囲）のどの場所かを指定するわけです。

>【(2)　ReDimでの説明と、ｖ　には全部のデータが入るのか教えてください？】

前述、配列 x に全シート名を入れました。
x にいくつの要素があるか、インデックスの最大値をUBound(x)で調べます。
これで取得したいデータが幾つあるかが判ります。
横方向（列方向）はB列からJ列まで書き出したいわけだから最初からわかってます。９コです。
縦方向（行方向）がUBound(x)コです。（nコ）

そこで配列 v のサイズを再割り当てします。
ReDim v(1 To n, 1 To 9)
タテが１からn、ヨコが１から９です。
これで全データがはいるはずです。

>【(3)　これだけですべてのデータが一覧表に入るのですか？入れるデータの範囲指定の方法の説明をお願いします。】

Sheets("一覧表").Range("B3:J3").Resize(n).Value = v
セル範囲を指定して、配列 v を書き出します。
この時、セル範囲を配列のサイズに合わせます。
すると一気に書き出す事ができます。

B列からJ列までは固定で判ってますから、タテ方向にセル範囲を広げてやればいいですよね。
[Resize プロパティ]で配列のタテサイズ、 n コ広げて指定すればいいのです。

前回qa5403717ではVBEヘルプの使い方を書きましたね。各語句はヘルプも参照してください。
また、デバッグ方法は知ってますか？コード内で[F8]キーを押すとコード１ステップずつ実行できます。
この時、VBEメニュー[表示]-[ローカルウィンドウ]を表示させてください。
[ローカルウィンドウ]で変数の中身を確認できます。
各変数の右の[+]マークを展開して、ステップ実行させながら、配列に値がどのように入ってくるか見てみると良いですよ。

#でも実をいうと、数式で工夫すればシート名をLoopしなくてもできそうですよ。っ的な事に目を向けてました。
#配列の方はおまけだったりして。

お礼

end-u様
私は会社で質問をしていたために返事が大変遅れまして、失礼いたしました。
詳細な説明をありがとうございます。
２次元配列について何となくわかったような気がしています。
四角なエリアを代入できるイメージに受けました。
各語句のヘルプは使ってみてはいるのでが、いまいち理解できなくて困って聞いてしまいました。
これからまたお伺いすることがあるかと思いますので、よろしくお願いします。
ありがとうございました。

回答No.3

米沢 栄蔵（@YON56）

お望みの構文を記述しますので、参考にして下さい。

Dim A,B,C
Sheets("一覧表").Select
For A=3 To 173
B=Cells(A,20).Value
Cells(A,3)=Sheets(B).Range("J3").Value
Cells(A,4)=Sheets(B).Range("J4").Value
Cells(A,5)=Sheets(B).Range("B6").Value
Cells(A,6)=Sheets(B).Range("F6").Value
Cells(A,7)=Sheets(B).Range("K6").Value
Cells(A,8)=Sheets(B).Range("C9").Value
Cells(A,9)=Sheets(B).Range("B8").Value
Cells(A,10)=Sheets(B).Range("F8").Value
Cells(A,11)=Sheets(B).Range("K8").Value
For C=9 To 11
IF Cells(A,C).Value="" Then
Cells(A,C)="-"
End If
Next C
Next A

お礼

YON56様
回答ありがとうございました。
私でも理解できそうな構文で、よく勉強させていただきます。
またよろしくお願いいたします。

回答No.1

avanzato

こんにちは。
上記のような処理の速度を上げるのでしたら
Application.ScreenUpdating
を付けるのが良いかと思いますが更に最速を目指すなら以下のようになります。
また、一覧表を作成せず一覧表自体も自動作成するようになっています。
Sub Auto_Open()
　'変数宣言
　Dim i As Integer
　Dim SheetCnt As Integer
　Dim SheetNm As String
　'画面更新 OFF
　Application.ScreenUpdating = False

　SheetCnt = ThisWorkbook.Sheets.Count - 1 　'ThisWorkbook.Sheets.Countでシートの数を呼び出す
　'↑一覧表分　-1　する。

　For i = 1 To SheetCnt
　　SheetNm = Sheets(i).Name　'シート名取得
　　Range("一覧表!B" & i + 2).Value = Range(SheetNm & "!J3").Value
　　Range("一覧表!C" & i + 2).Value = Range(SheetNm & "!J4").Value
　　Range("一覧表!D" & i + 2).Value = Range(SheetNm & "!B6").Value
　　Range("一覧表!E" & i + 2).Value = Range(SheetNm & "!F6").Value
　　Range("一覧表!F" & i + 2).Value = Range(SheetNm & "!K6").Value
　　Range("一覧表!G" & i + 2).Value = Range(SheetNm & "!C9").Value
　　If Range(SheetNm & "!B8").Value <> "" Then
　　　Range("一覧表!H" & i + 2).Value = Range(SheetNm & "!B8").Value
　　Else
　　　Range("一覧表!H" & i + 2).Value = "-"
　　End If
　　If Range(SheetNm & "!F8").Value <> "" Then
　　　Range("一覧表!I" & i + 2).Value = Range(SheetNm & "!F8").Value
　　Else
　　　Range("一覧表!I" & i + 2).Value = "-"
　　End If
　　If Range(SheetNm & "!K8").Value <> "" Then
　　　Range("一覧表!J" & i + 2).Value = Range(SheetNm & "!K8").Value
　　Else
　　　Range("一覧表!J" & i + 2).Value = "-"
　　End If
　Next i
　'画面更新 ON
　Application.ScreenUpdating = True
　MsgBox ("完了")
End Sub

お礼

avanzato様
早速の回答ありがとうございます。
よくわからない処もあるので、勉強させていただきます。
ありがとうございました。
またよろしくお願いします。

補足

avanzato様
私は画像を止めることができれば早くなると思っていたのですが、コードがわからなかったので教えていただきましてありがとうございました。それだけでもかなり速くなりました。
ありがとうございました。