質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

最適化

最適化とはメソッドやデザインの最適な処理方法を選択することです。パフォーマンスの向上を目指す為に行われます。プログラミングにおける最適化は、アルゴリズムのスピードアップや、要求されるリソースを減らすことなどを指します。

Q&A

解決済

4回答

3999閲覧

エクセルのマクロを高速化する方法でCase文を使用したくないのですがVBAで関数のテーブル化みたいなのは出来るのでしょうか?

ma2hiro

総合スコア157

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

最適化

最適化とはメソッドやデザインの最適な処理方法を選択することです。パフォーマンスの向上を目指す為に行われます。プログラミングにおける最適化は、アルゴリズムのスピードアップや、要求されるリソースを減らすことなどを指します。

0グッド

1クリップ

投稿2021/03/01 09:43

編集2021/03/23 05:11

お世話になっております。

とりあえずはVBAが使えるレベルの初心者なのですが
社内で使っているVBAの集計マクロが重くて改修したいと思っております。

なんかざっと見た所
※Case文が多い
【勝手に思っている解決方法】→(出来るかどうか知らないが関数の配列っぽいので高速化出来ないか?)
※文字列をコピーするのに一々一つずつコピーしている
【勝手に思っている解決方法】→(空白のシートに【結局】一々コピーして最後にまとめて配列コピー)
などまだ構成段階ですが思っております。

上記※の2点に関してお伺いいたします。
※Case文を関数に というのは出来るのでしょうか?
※配列に書いてまとめて配列をコピー というのは配列を作成する段階でコピーしているので意味が無いような気がしますが
何か値をコピーするのに高速化する方法はあるのでしょうか?
今は

For Col = 1 To 44 With Ws.Cells(TargetRo, Col) Select Case Col Case 1 ' strDatを作る処理 .Value = strDat Case 2 ' strDatを作る処理 .Value = strDat : ; Case 44 .Value = Dat(Col - 4) End Select End With Next

上記のように実装しております。
ですが重いので配列にコピーして最後に配列でうんこらしょとコピーした方が早いらしいので
そのようにしようかと思っていましたが結局値を上記のように入れているのであんまり意味が無いのかと思っております。

Teratailを検索すると
VBA - Excel VBA 行挿入の高速化|teratail
が見つかったので画面更新は止めようかと思っていますが
上記2点
・Case文を関数で配列化出来るか?
・配列コピーの方が早いが結局は作業用ワークシートにコピーするので意味が無いのでは無いか?

以上2点お問い合わせいたします。

またVBA 高速化 でググって出てきた文章を上から見ていくと
VBAの高速化 - 人はエクセルの能力の10%も使っていない?
がためになりそうでしたので後で実装予定です。

 【追記】

何かおもったようにパフォーマンスが上がらないので私は何か勘違いしているのかと思い
ソースの概要を貼り付けてアドバイスを頂ければと思ったため貼り付け失礼します。

vba

1Public Function Main(actWs As Worksheet) As Boolean 'Thisworkbook.getData 2 3'宣言とか色々 4 5 Debug.Print Time & " - スタート" 6 7 Const fDebug As Boolean = False 'Falseだと高速化対応中 8 If (fDebug) Then 9 Else 10 Dim wb As Workbook 11 Set wb = Workbooks.Open(strPath & strFileName) 12 '    ↑↑↑↑↑↑↑が時間がかかるとの事なのでこちらを一回にまとめました 13 End If 14 15 For i = 0 To UBound(SheetNamesList) 16 '読み込んでいるとのプログレスバーの処理 17 With ProgForm 18 If i > .ProgressBar1.Min And _ 19 i <= .ProgressBar1.Max Then 20 'ProgressPercent = CInt(i / UBound(SheetNamesList) * 100) 21 .Label1.Caption = "評価表シートからデータを読み込んでいます。( " & i + 1 & " / " & UBound(SheetNamesList) + 1 & ")" 22 .ProgressBar1.Value = i 'プログレスバーの値を更新 23 DoEvents '滞留処理を実行 24 End If 25 End With 26 '読み込んでいるとのプログレスバーの処理ココまで 27 28 If (fDebug) Then 29 '評価表シートからデータの取得 30 Dat = ReadData(strPath, strFileName, SheetNamesList(i), EvaluationListType) 31 '↑でなんか毎回閉じている気がするので開きっぱなしでやってみたのが↓ で早くなったかどうか分からないので……元のヤツを持ってくるか…… 32 Else 33 'こっちは早くしたつもりなんだけどな…… 34 Dat = ReadDataEx2(wb, SheetNamesList(i), EvaluationListType) 35 End If 36'不要かと思って削除したがココが重い予感 ココから================================ 37 If IsArray(Dat) Then 38 Debug.Print Time, "PutData", "Start" 39 '集計表へのデータ記入 下が重い 40 If (fDebug) Then 41 If Not PutData(actWs, Dat, SheetNamesList(i)) Then GoTo ErrProc3 42 Else 43 If Not PutDataEx2(actWs, Dat, SheetNamesList(i)) Then GoTo ErrProc3 44 End If 45 46 Debug.Print Time, "PutData", "End" 47 Else 48 Msg = "「" & SheetNamesList(i) & "」シートが削除されているか、評価表年度と台帳年度が一致しません。" & vbLf _ 49 & " このシートの読み込みをスキップします。" 50 Call Tools.ShowInfForm2("E", "シートの不在確認", True, "閉じる", False, "", Msg, 0, 0) 51 End If 52'不要かと思って削除したがココが重い予感 ココまで================================ 53 54 Next 55 56 If (fDebug) Then 57 Else 58 wb.Close SaveChanges:=False 59 End If 60 61 Debug.Print Time & " - エンド" 62 63Exit Function 64 65 66' ReadDataが重かったのでReadDataEx2に改修。 67' 改修した手法としては 68' ・Workbook.openが重いとの事で一つ開きっぱなしにして毎回Openしない 69' ・ 70Private Function ReadDataEx2(ByVal wb As Workbook, ByVal SheetNames) As Variant 71'評価表からデータ取得 72 73 74 Dim Dat(40) As Variant, KeyWord As Variant 75 Dim BizWs As Worksheet, Msg As String 76 Dim PathFileSheet As String, strTemp As String 77 Dim i As Integer, FiscalYear As Integer 78 Dim Repres As String, JobPosition As String 79 80 'CellDatas内にデータをコピー 81 Dim CellDatas As Variant 82 CellDatas = wb.Sheets(SheetNames).Range("A1:AI35") 83 84 On Error GoTo ErrProc 85 FiscalYear = Val(CellDatas(2, 13)) '年度表示 86 '年度の整合性検査 87 'Debug.Print Val(ThisWorkbook.ActiveSheet.Cells(1, 1).Value) 88 If FiscalYear <> Val(ThisWorkbook.ActiveSheet.Cells(1, 1).Value) Then 89 GoTo ErrProc 90 End If 91 '読み取りシートがない場合はエラー 92' Dat(1) = ExecuteExcel4Macro(PathFileSheet & 5 & "C" & 5) '評価実施日 93' Dat(1) = CLng(wb.Sheets(SheetNames).Cells(5, 5).Value) '評価実施日 94 Dat(1) = CLng(CellDatas(5, 5)) '評価実施日 95 If Dat(1) > ThisWorkbook.RecentRatingDay Then ThisWorkbook.RecentRatingDay = Dat(1) 96 On Error GoTo 0 97 98 Dat(2) = CellDatas(6, 5) '評価店所名 99 With EvaluationSheet '評価表 100 101 Dat(4) = CellDatas(12, 11) '業種CD 102 Dat(5) = CellDatas(12, 5) '業務内容/品目 103 104'このような内容がDat(34)まで続いている 105 'Dat(34) = ExecuteExcel4Macro(PathFileSheet & 11 & "C" & 11) '取引先担当者 106 'Dat(34) = wb.Sheets(SheetNames).Cells(11, 11).Value '取引先担当者 107 Dat(34) = CellDatas(11, 11) '取引先担当者 108 109 '業務内容/品目 110 On Error GoTo ErrProc 111 KeyWord = Split(wb.Sheets(SheetNames).Cells(35, 3).Value, ",") 112 ReDim Preserve KeyWord(3) 113 For i = 0 To 3 'UBound(KeyWord) 114 Dat(35 + i) = Left(KeyWord(i), 12) 'Dat(35)~Dat(38) 115 If Dat(35 + i) = "" Then Dat(35 + i) = "-" 116 Next 117 On Error GoTo 0 118 119 End With 120 121 '文字種の変更 122 For i = 0 To UBound(Dat) 123 If Dat(i) <> "" And i <> 9 And i <> 34 Then Dat(i) = ChangeChr(Dat(i), i) 'i=7,8はCol=10,11 124 Next 125 126 ReadDataEx2 = Dat 127 128Exit Function 129 130ErrProc: 131 ReadDataEx2 = "Err" 132 133End Function 134

土日にでもじっくり見て動作の高速化を考えてみますがどうすれば早くなりそうかコメント頂ければ幸いです。

【追記その2】

'なので高速化予定として作成するか…… Private Function PutDataEx2(Ws As Worksheet, Dat As Variant, EvaluationSheetName As Variant) As Boolean Dim LastRo As Long, TargetRo As Long Dim Col As Integer, strDat As String Dim temp As Variant, Msg As String, Res As Integer LastRo = getLastRoExTempRow(Ws) 'テンプレート行-1 'cells(9,11)は「この行はテンプレートです。記入できません。」 If LastRo < 9 Then TargetRo = 9 Else TargetRo = LastRo + 1 Call CopyTemplateRow(Ws, TargetRo) '評価表の二重オープンを防ぐこと PutDataEx2 = True For Col = 1 To 44 '43 '42 With Ws.Cells(TargetRo, Col) Select Case Col Case 1 If Dat(14) = "継続" Then strDat = "2" ElseIf Dat(14) = "新規" Then strDat = "1" Else strDat = "" End If .Value = strDat Case 2 If Dat(15) = "外注" Then strDat = "2" ElseIf Dat(15) = "資材" Then strDat = "1" Else strDat = "" End If .Value = strDat ’どうしても.VLookupなどをどのように実装すれば良いのか不明なので追記 Case 5 '評価店所名 If Dat(2) = "" Then Msg = "「評価店所名」に記入がありません。" GoTo ErrProc End If .Value = Dat(2) '-----店番 temp = Replace(Dat(2), "支店", "") temp = Replace(temp, "事業所", "") temp = Replace(temp, "営業所", "") With Worksheets("業種CD") '店番 On Error Resume Next temp = Application.WorksheetFunction _ .VLookup(temp, .Range(.Cells(3, 5), .Cells(31, 6)), 2, False) On Error GoTo 0 End With .Offset(0, -2).Value = temp ’追記ココまで ErrProcは省略します。.VLookupや.Offsetの実装方法を知りたいので ' こういったのが  ↓まで続く Case 44 '前一年間の取引実績 .Value = Dat(Col - 4) Case Else ' If Ro = 9 And Col = 5 Then Ws.Cells(5, 8).Value = Dat(0) & "継続外注取引先" .Value = Dat(Col - 3) 'Dat(Col - 5) End Select '取引店所、業種名、取引先名カナ、取引先名、代表者職位・氏名、住所、条件、取引先担当者名、業務内容/品目1~4 ' If Col = 5 Or Col = 8 Or Col = 10 Or Col = 11 Or Col = 12 Or Col = 14 Or Col >= 37 Then .Font.Name = "Meiryo UI" ' End If End With Next End Function

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

hatena19

2021/03/01 10:40

たかだか44列の代入だけで時間がかかるとは思えません。 strDatを作る処理に時間がかかっている可能性の方が高いです。 strDatの部分を定数値に置き換えて実験してみてどのくらい時間がかかるか測定してみてください。
meg_

2021/03/01 12:05

> 画面更新は止めようかと思っていますが 現在は何分かかっているのでしょうか? 上記対応でどのくらい速くなりましたか?
jinoji

2021/03/01 13:09

strDatを作る処理 は各列によって全て異なるのですか?
hatena19

2021/03/01 13:11

画面更新抑制、配列を使用してセルアクセスを極力減らすというのはそれなりに効果はありますが、 提示のコードは44回のセルアクセス、代入ですので体感できる改善はないでしょう。 Case文も時間がかかるような処理ではありません。 何に時間がかかっているかを特定することが先決でしょう。 「strDatを作る処理」を省いて実行して時間を計測してみる。 「strDatを作る処理」だけを取り出して時間を計測してみる。 というような作業をまずはしましょう。
ma2hiro

2021/03/01 19:44

皆様ありがとうございます。 仰る通りどこが時間がかかっているか分からないのに高速化も無いですね…… 時間を測って調べようかと思います。 https://excel-ubara.com/excelvba4/EXCEL260.html に記載のように Debug.Print Timer で良いのかもっと良い方法があるのか不明ですが 皆様コメントありがとうございます。 どこが遅いのか調べてみますっ
ma2hiro

2021/03/02 01:09

msuguruさん ありがとうございます。 Application.ScreenUpdating =False は実装しているので test8 0.53秒 セルの書式設定を一括で設定 ここらへんを見てみますっ
guest

回答4

0

・Case文を関数で配列化出来るか?

私は知りません。case文を使いたくない理由は処理速度に対する疑念からですか?
であれば、それほど影響は無いかと思われます。

・配列コピーの方が早いが結局は作業用ワークシートにコピーするので意味が無いのでは無いか?

意味がないことはありません。
各セルのRangeオブジェクトにアクセスして値をセットするより
範囲のRangeオブジェクトに配列をセットした方が早いです。

実証としてcaseの使用も含めて計測用にコードを書いてみました。

VBA

1Public Sub test() 2 Dim tTimer As Single 3 Dim tCol As Long 4 Dim tRow As Long 5 Dim tV1(1 To 44) As Variant 6 Dim tV2(1 To 10000, 1 To 44) As Variant 7 Rnd 0 8 Sheet1.Cells.Clear 9 tTimer = Timer 10 For tRow = 1 To 10000 11 For tCol = 1 To 44 12 Sheet1.Cells(tRow, tCol).Value = Rnd() 13 Next 14 Next 15 Debug.Print (Timer - tTimer) 16 Sheet1.Cells.Clear 17 tTimer = Timer 18 For tRow = 1 To 10000 19 For tCol = 1 To 44 20 With Sheet1.Cells(tRow, tCol) 21 Select Case tCol 22 Case 1 23 .Value = Rnd() 24 Case 2 25 .Value = Rnd() 26 Case 3 27 .Value = Rnd() 28 '<略> 29 Case 43 30 .Value = Rnd() 31 Case 44 32 .Value = Rnd() 33 End Select 34 End With 35 Next 36 Next 37 Debug.Print (Timer - tTimer) 38 Sheet1.Cells.Clear 39 tTimer = Timer 40 For tRow = 1 To 10000 41 For tCol = 1 To 44 42 tV1(tCol) = Rnd() 43 Next 44 Sheet1.Range("A" & tRow & ":AR" & tRow).Value = tV1 45 Next 46 Debug.Print (Timer - tTimer) 47 Sheet1.Cells.Clear 48 tTimer = Timer 49 For tRow = 1 To 10000 50 For tCol = 1 To 44 51 tV2(tRow, tCol) = Rnd() 52 Next 53 Next 54 Sheet1.Range("A1" & ":AR10000").Value = tV2 55 Debug.Print (Timer - tTimer) 56End Sub

これを今実行した結果は以下の通りでした。
16.70313
16.70313
1.28125
0.765625

※1行目と2行目は今実行したら同じでしたが違う環境で
実施したら当然ながら2行目の方が遅かったです。

つまり、処理時間の長さを比較すると以下の通りと思われます。

case文の判定有り+各セルに値設定>各セルに値設定>行毎に値を設定>全セルを一括設定

配列でまとめてセットした方が圧倒的に早いです。
またcase文の判定による影響はそれ程大きくないかと思われます。

補足ですが、エクセルに計算式が入っていた場合
その内容次第で個別に値をセットする時更に遅くなります。

一応質問内容がcaseb文についてと配列によるコピーについてでしたので
このような回答になりました。

投稿2021/03/17 13:05

xail2222

総合スコア1497

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ma2hiro

2021/03/19 08:34

xail2222様 コメントありがとうございます。 →case文の判定有り+各セルに値設定>各セルに値設定>行毎に値を設定>全セルを一括設定 との情報ありがとうございます。 Dim Dat(40) As Variant にまとめて返しているのでそこは大丈夫だと思います。 うーんexcelは事務方が操作するから簡単だろうと思って侮っていました……難しいっ
guest

0

ベストアンサー

転記元のシート数が多いということなので、自分ならこんな感じにします。

VBA

1 2 '処理のいちばん最初に転記元ファイルを連想配列dicに取得し、すぐ閉じる 3 Dim wb As Workbook 4 Set wb = Workbooks.Open(strTemp) 5 Dim dic 'As Scripting.Dictionary 6 Set dic = CreateObject("Scripting.Dictionary") 7 Dim ws As Worksheet 8 For Each ws In wb.Worksheets 9 '全てのシートのデータを連想配列に格納 10 dic(ws.Name) = ws.Range(ws.Range("A1"), ws.Cells.SpecialCells(xlCellTypeLastCell)).Value 11 Next 12 wb.Close False 13 ' ここまでせいぜい数秒だと思う。 14 15 '以降は、いままでwbから読んでいたところを、以下のように書き換える 16 'Dat(4) = wb.Sheets(SheetNames).Cells(12, 11).Value '業種 17 '↓ 18 Dat(4) = dic(SheetNames)(12, 11) '業種 19

<追記>
転記元は1ファイルに100シート程度、転記先は1シートに100行程度、という情報から、
転記先の1行と転記元の1シートが対応づいていると仮定すると、
後続の処理は以下の感じにすればいいのかな、という想像をしています。

VBA

1 '転記先シート 2 Dim EvaluationSheet As Worksheet 3 Set EvaluationSheet = ThisWorkbook.Worksheets(1) 4 5 With EvaluationSheet 6 Dim startRow, endRow 7 startRow = 10 ’たとえば10行目からがデータ行の場合 8 endRow = .Cells.SpecialCells(xlCellTypeLastCell).Row 9 10 '転記先データ範囲 11 Dim EvaRange As Range, EvaArr As Variant 12 Set EvaRange = .Range("A1").Resize(endRow, 44) 13 14 '転記先の値を転記先用配列に取得 15 EvaArr = EvaArr.Value 16 17 '順次処理 18 Dim TargetRo, shtName 19 For TargetRo = startRow To endRow 20 21 '転記元シート名の決定 22 shtName = EvaArr(TargetRo, 1) 23 24 'シート名をキーに連想配列から配列を取り出し、転記先用配列の各列の値をセット 25 EvaArr(TargetRo, 4) = dic(shtName)(2, 13) ' 26 EvaArr(TargetRo, 5) = dic(shtName)(12, 11) '業種 27 ' 28 EvaArr(TargetRo, 44) = dic(shtName)(33, 22) 'xx 29 Next 30 31 '転記先用配列の値をシートに反映 32 .Value = EvaArr 33 End With 34

<追記>

VBA

1Private Function PutDataEx2(ws As Worksheet, Dat As Variant, EvaluationSheetName As Variant) As Boolean 2 Dim TargetRo As Long 3 Dim Col As Integer, strDat As String 4 5 TargetRo = getLastRoExTempRow(ws) + 1 6 If TargetRo < 9 Then TargetRo = 9 7 8 Call CopyTemplateRow(ws, TargetRo) 9 10 Dim arr(1 To 44) '格納用配列 11 For Col = 1 To 44 12 Select Case Col 13 Case 1 14 If Dat(14) = "継続" Then 15 strDat = "2" 16 ElseIf Dat(14) = "新規" Then 17 strDat = "1" 18 Else 19 strDat = "" 20 End If 21 arr(Col) = strDat 22 Case 2 23 If Dat(15) = "外注" Then 24 strDat = "2" 25 ElseIf Dat(15) = "資材" Then 26 strDat = "1" 27 Else 28 strDat = "" 29 End If 30 arr(Col) = strDat 31 32 33 Case 44 '前一年間の取引実績 34 arr(Col) = Dat(Col - 4) 35 Case Else 36 arr(Col) = Dat(Col - 3) 'Dat(Col - 5) 37 End Select 38 Next 39 40 '格納 41 With ws.Rows(TargetRo).Resize(, 44) 42 .Value = arr 43 '.Font.Name = "Meiryo UI" 44 End With 45 46 PutDataEx2 = True 47 48End Function 49

投稿2021/03/11 09:47

編集2021/03/22 14:37
jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ma2hiro

2021/03/12 04:53

Jinoji様 ありがとうございます。 こちらもよく読んで理解して取り入れたいと思いますっ
ma2hiro

2021/03/17 08:51 編集

jinoji様 ご返答頂いていたのにないがしろにしていて大変申し訳ございません…… ちょっと上手く組み込めなかったので後回しにしてしまいました。 今現在ご連絡頂いたように組み込もうとしているのですが ``` コンパイルエラー 配列には割り当てられません。 ``` と表示されPrivate Function ReadData…が黄色くフォーカスされてコンパイルが通らない状況です……  以下のソース部分の”追記ココから””追記ココまで”を追記したら上記のエラーが出るようになりました…… ``` Private Function ReadData(ByVal wb As Workbook _ , ByVal SheetNames, ByVal EvaluationListType As String) As Variant '  追記ココから Dim Dat(40) As Variant, KeyWord As Variant Dim CellDatas(40, 40) As Range CellDatas = wb.Sheets(SheetNames).Range(Cells(1, 1), Cells(12, 13)) '  追記ココまで With EvaluationSheet Dat(4) = wb.Sheets(SheetNames).Cells(12, 11).Value '業種CD Dat(5) = wb.Sheets(SheetNames).Cells(12, 5).Value '業務内容/品目 ' 以下読み込む End With ReadData = Dat Exit Function ``` こちらどのようにすればコンパイル通るのかどのように語句で検索すれば良いのかご助力頂けないでしょうか? お忙しい所大変申し訳無いのですが上記お問い合わせいたします。
jinoji

2021/03/17 08:55

とりあえず Dim CellDatas(40, 40) As Rangeのところを Dim CellDatas As Variant にしましょう
ma2hiro

2021/03/18 00:21

jinoji様 コメントありがとうございます。 Dim CellDatas As Variant とすると CellDatas = wb.Sheets(SheetNames).Range(Cells(1, 1), Cells(12, 13)) ←で ``` 実行時エラー'1004' アプリケーション定義またはオブジェクト定義のエラーです。 ``` と言われるのです…… もう少し調べてみます。 本当に初心者で申し訳ございません……
jinoji

2021/03/18 00:27

CellDatas = wb.Sheets(SheetNames).Range("A1:M12")
ma2hiro

2021/03/18 00:33

jinoji様 ありがとうございます。こちらで実装してみますっ
ma2hiro

2021/03/18 05:45

jinoji様 本当に度々申し訳ございません。 以下のような関数にてデータを読み込もうとしておりますが 上手くデータが取得出来ません…… ``` '<IN> ' wb   ……読み込むワークブック ' SheetName…読み込むシート名 '<OUT> ' ReadData …配列で値を返却 Private Function ReadData(ByVal wb As Workbook, ByVal SheetNames) As Variant Dim Dat(40) As Variant Dim i As Integer, FiscalYear As Integer Dim CellDatas As Variant CellDatas = wb.Sheets(SheetNames).Range("A1:M13") FiscalYear = Val(wb.Sheets(SheetNames).Cells(2, 13).Value) '年度表示 前まで FiscalYear = CellDatas.Cells(2, 13).Value '年度表示 今回から修正中 ' : ' : ' : On Error GoTo ErrProc ReadData = Dat ``` デバッガで見ると FiscalYear = Val(wb.Sheets(SheetNames).Cells(2, 13).Value) '年度表示前まで の方には値が入っているのですが FiscalYear = CellDatas.Cells(2, 13).Value '年度表示 今回から修正中 でエラーのようでデバッガで中身を見ようとしても↑からすぐエラーに飛んでいます…… こちらうまく値を入れるためにはどのようにすれば良いのか もしくはどのような語句で調べればそちらの情報がヒットするのかご教授頂ければ幸いです……
sinya0320

2021/03/18 06:17

CellDatas = wb.Sheets(SheetNames).Range("A1:M13") FiscalYear = CellDatas.Cells(2, 13).Value CellDatasには、wb.Sheets(SheetNames).Range("A1:M13")が入っています。 置き換えると FiscalYear = wb.Sheets(SheetNames).Range("A1:M13").Cells(2, 13).Value となっています。 ここまで頑張ってこられているので 何が誤りかはわかると思います。
jinoji

2021/03/18 06:22

パッと見た範囲でいうと、マズそうなところが2点あります。 まず、CellDatas.Cells(2, 13).Value と書くのは間違いで、CellDatas(2, 13) としないといけません。 (.Value という書き方は、セルの値を取得するときの書き方ですが、 CellDatas = wb.Sheets(SheetNames).Range("A1:M13") とした時点で、  CellDatasという変数はセル範囲ではなく普通の2次元配列です。) 次に、もともとあったVal( ) がなくなっています。 いま参照しているデータにはおそらく "2020年度" とか "2020/4/1" とかの値が入っていて、 Val関数を使うことで、その文字列の先頭の数字部分(上記例でいうと2020)を取得します。 Val関数で処理しないと、FiscalYear は、 Integer型ですので、 ”2020年度”なら数値型に文字列を入れようとすることになりエラーが発生しますし、 "2020/4/1"とかでも、Integerの範囲を超えた値になるのでオーバーフローのエラーになると思います。 つまり、今回の場合、 FiscalYear = Val(CellDatas(2, 13)) とするのがよさそうです。
jinoji

2021/03/18 06:23

長々と書いている間にsinya0320さんがフォローしてくださってましたね。失礼しました。
ma2hiro

2021/03/18 06:50 編集

御二方 本当にありがとうございます。 FiscalYear = Val(CellDatas(2, 13)) で実装出来ましたっ 本当に御二方のようにすぐ返答出来るような知識を高めます!!!
ma2hiro

2021/03/19 06:30

すいません…… 仰られたように修正したのですが速度が上がらなかったためTOPに【追記】しました…… 私の理解度が低くて本当に申し訳ないのですがご助力頂ければ幸いです。
jinoji

2021/03/19 09:01

このMain というファンクションは、 どこから何回ぐらい呼び出されるんですか? そして、1回あたり何分ぐらいかかるんですか?
jinoji

2021/03/19 09:12

というか、ここでセットしたDatはどう使われるんですか。
ma2hiro

2021/03/19 09:30

jinoji様 ありがとうございますっ ``` If IsArray(Dat) Then '集計表へのデータ記入 If Not PutData(actWs, Dat, SheetNamesList(i)) Then GoTo ErrProc3 Else Msg = "「" & SheetNamesList(i) & "」シートが削除されているか、評価表年度と台帳年度が一致しません。" & vbLf _ & " このシートの読み込みをスキップします。" Call Tools.ShowInfForm2("E", "シートの不在確認", True, "閉じる", False, "", Msg, 0, 0) End If ``` で書き込んでいるのですが putの方が時間がかかっている気がしてきましたっ 勝手に読み込みで時間がかかっていると思い込んでいたようなので 書き込みの方も見てみますっ 本当にありがとうございました!!!
jinoji

2021/03/19 09:43

これまでもいろんな方が、まずはどこに時間がかかっているのか突き止めろとアドバイスしてると思うんですが・・・ 処理時間の改善をしたいなら、一旦すべてのFunctionの先頭と最後に Debug.Print Time ,"Function名" , "Start" Debug.Print Time ,"Function名" , "End" を入れるくらいしても罰は当たらないですよ。
jinoji

2021/03/19 09:57

ReadDataEx2 の処理については、 多少の改善の余地はありそうですが、それほど明白な非効率箇所はないように思います。 <多少の改善の余地> KeyWord = Split(wb.Sheets(SheetNames).Cells(35, 3).Value, ",") のところは KeyWord = Split(CellDatas(35, 3), ",") に出来そう Val(ThisWorkbook.ActiveSheet.Cells(1, 1).Value) の値はたぶん処理中はずっと同じなので、 この処理の中で毎回(100回)セルから取得するより、 呼び出し元のFor文の前で1回取ってそれを引数として渡せばよさそう。 というか呼び出すときの引数の数が違うがどっちが正しいのか。
ma2hiro

2021/03/20 00:38

ありがとうございます。 >処理時間の改善をしたいなら、一旦すべてのFunctionの先頭と最後に >Debug.Print Time ,"Function名" , "Start" >Debug.Print Time ,"Function名" , "End" >を入れるくらいしても罰は当たらないですよ。 をやってみます。 本当に理解度が低くて申し訳ございません。 見捨てないでコメント頂き感謝いたします。
ma2hiro

2021/03/22 05:10

やってみましたが一秒ぐらいのが続いて なんアルゴリズムが良くない気がしてきました。 Dat Data入れる配列 WS ワークシート while(シート数分){  Datにデータ読む  WSにデータを書き込む } にて「WSにデータを書き込む」部分が毎回閉じている予感なので 開きっぱなしにしてそこを高速化出来るようにしてみようと思います。 本当にありがとうございました。
jinoji

2021/03/22 05:35

wsにデータを書き込む時に、 44箇所書き込むところがあるとして、 1セルずつ44回書き込むのと、 44セルをまとめて1回で書き込むのとでは、 かなりスピードが変わりますので、 そこをまず確認ですかね。 PutDataのコードが追記されたらもう少し具体的にいえるかもしれませんが、とりあえず。
ma2hiro

2021/03/22 08:45

jinoji様 コメント本当にありがとうございます。 jinoji様のコメントが無かったら心が折れていました。 とりあえず Call CopyTemplateRow(Ws, TargetRo) でコピーして44個selectで回して値がそれだったら書き換えています。 【追記】の "'不要かと思って削除したがココが重い予感 ココから"から ”'不要かと思って削除したがココが重い予感 ココまで”と 【追記その2】を加えました。 前任者がやりたい事は分かるのですが もっと良いコードがある気がしていますが思いつかないのでモヤモヤしております。 以上ご連絡いたします。ご助力頂ければ幸いです。
ma2hiro

2021/03/23 00:33

<追記>ありがとうございます。 ちょっと見てみますっ
ma2hiro

2021/03/23 01:46

``` '格納 With ws.Rows(TargetRo).Resize(, 44) .Value = arr '.Font.Name = "Meiryo UI" End With ``` で早くなった気がします。なるほどですっ もう少し見てみます。 本当にありがとうございました。
ma2hiro

2021/03/23 05:14

jinoji様 大変申し訳ございません。 TOPに追記としてCase5のように ご教授頂いた方法での .VLookupや.Offsetの実装方法を知りたいです…… 何か調査方法などご助力頂ければ幸いです…… 本当に力不足で申し訳ないです……
jinoji

2021/03/23 07:13

とりあえずはこうかな。 Case 5 '評価店所名 If Dat(2) = "" Then Msg = "「評価店所名」に記入がありません。" GoTo ErrProc End If arr(Col) = Dat(2) '-----店番 temp = Replace(Dat(2), "支店", "") temp = Replace(temp, "事業所", "") temp = Replace(temp, "営業所", "") With Worksheets("業種CD") '店番 On Error Resume Next temp = Application.WorksheetFunction.VLookup(temp, .Range(.Cells(3, 5), .Cells(31, 6)), 2, False) On Error GoTo 0 End With arr(Col - 2) = temp
jinoji

2021/03/23 07:24

ここの処理はE列の店名から店番号を「業種CD」シートから引き当ててC列に埋める処理だと思いますが 今の処理構成だと、1行ごとのデータを組み立てていく感じなので、 毎回「業種CD」シートを読むことになります。 その点、処理の工夫(C列の処理を後でまとめてやるようにするとか)によって 多少の処理速度向上はできるかもしれません。(そんなに劇的には変わらないと思いますが)
ma2hiro

2021/03/23 08:06

jinoji様 本当にありがとうございます。 arr(Col - 2) = temp との情報ありがとうございます。 落ち着いて考えればそうですよね…… 焦ってしまい書き込んでしまい失礼しました。 >ここの処理はE列の店名から店番号を「業種CD」シートから引き当ててC列に埋める処理だと思いますが >今の処理構成だと、1行ごとのデータを組み立てていく感じなので、 >毎回「業種CD」シートを読むことになります。 こちらも考えてみます。 本当にありがとうございました。 引き継いだexcelVBAがスパゲッティでコメントも無いので 泣きそうになりながら修正していたので本当に助かりました。 頑張ってスキルアップしていきますっ
guest

0

まず配列を使用する計算とエクセルを使用する計算について誤解があるためこちらに回答します。

あなたは学校から宿題を出されました。
Excelブックは学校に当たります。
配列は自宅の部屋に当たります。
効率的に行うのであれば学校から宿題を全て持ち帰り自宅の部屋で全て作業を行い学校へ提出します。
この場合学校には二回だけアクセスしますね。

提示されたコードを見てみます。

VBA

1FiscalYear = Val(wb.Sheets(SheetNames).Cells(2, 13).Value) '年度表示 2 Dat(1) = CLng(wb.Sheets(SheetNames).Cells(5, 5).Value) '実施日 3 Dat(2) = wb.Sheets(SheetNames).Cells(6, 5).Value '店名 4With EvaluationSheet '評価表 5 Dat(4) = wb.Sheets(SheetNames).Cells(12, 11).Value '業種 6 Dat(5) = wb.Sheets(SheetNames).Cells(12, 5).Value '品目 7 Dat(7) = wb.Sheets(SheetNames).Cells(9, 5).Value '取引先名カナ(半角)=SubcontractorKana 8End With

.Valueは全てExcelのオブジェクトを触っています。
上記コードは宿題を持ち帰らず学校で一問だけ覚えて自宅で計算を行っています。
.valueでオブジェクトに触る行為は信じられないくらい遅いのです。
複数のサイトに記載されているように配列の中へ入れて極力計算を行いなさいと言っているのはそのためです。

一括で行う場合は下記となります。

VBAdim

1'Excelを一回触る 2CellDatas = wb.Sheets(SheetNames).Range(Cells(1,1),Cells(12,13)) 3 4'下記は全て配列内で計算 5FiscalYear = Val(CellDatas(2, 13)) '年度表示 6 dat(1) = CLng(CellDatas(5, 5)) '実施日 7 dat(2) = CellDatas(6, 5) '店名 8With EvaluationSheet '評価表 9 dat(4) = CellDatas(12, 11) '業種 10 dat(5) = CellDatas(12, 5) '品目 11 dat(7) = CellDatas(9, 5) '取引先名カナ(半角)=SubcontractorKana 12End With 13 14'~処理略~ 15 16'Excelを一回触る 17wb.Sheets(SheetNames).Range(Cells(1,1),Cells(12,13)) = CellDatas

可能な限り配列内で処理を行い、最終的に貼り付けたい形式を2次元配列で一回だけ貼り付け直します。
二次元配列をExcelに貼り付ける場合、同じサイズの範囲を指定すればOKです。
(上記の例題ではCellDatas(12,13)のサイズのため貼り付け直しが可能)
そうすればExcelへのアクセスは2回に留まり早くなります。

.Openでエクセルを開いて閉じる行為自体は本来0.5秒ほどです。
その時間を惜しんでxlsxブックをcsvに変換するのは本末転倒です。
プログラムの処理時間は確かに早くなるかもしれませんがcsvへの変換にかかる時間を考慮すれば明らかに遅くなります。
case文の使用も速度にはさほど影響がありません。

これはコメントにも投稿しましたが、test11に近い形の記載です。
投稿主が行っているのはtest3くらいのケースになります。
リンク内容

勿論この変更を行ってもまだ遅いかもしれません。
どの部分が遅いのかは投稿主が時間を図ってみて正しい修正箇所を探すのが一番の近道です。
時間を計測する際には大まかに一括りで探してみてもいいのですが、.Openで実際にどのくらい時間がかかっているのかは一度計測してみてください。

投稿2021/03/11 08:58

退会済みユーザー

退会済みユーザー

総合スコア0

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

ma2hiro

2021/03/17 07:11

ありがとうございます。 もう退会されていらっしゃいますが ``` 'Excelを一回触る CellDatas = wb.Sheets(SheetNames).Range(Cells(1,1),Cells(12,13)) ``` の手法をご教授頂きありがとうございます。 参考にして速度を見てみます。
guest

0

まだ調査中ですが

VBA

1Dat(4) = ExecuteExcel4Macro(PathFileSheet & 12 & "C" & 11)

が遅いような気がします……

デバッグで見てみると
PathFileSheet が シート名
というのは分かるのですが  & 12 & "C" & 11 というのが何か分かりません……

デバッグで追えないので
Googleで調べると
(ExecuteExcel4Macroについて)[https://excel-ubara.com/excelvba4/EXCEL219.html]

ExecuteExcel4Macroは、Excel4.0のマクロを実行します。 つまり、昔のマクロを使うということです。

と表記してあるのですがこの場合の昔のマクロというのが分かりません”&”で繋げる何かのマクロあるのでしょうか?

情報をお持ちな方は検索用語をご教示頂けないでしょうか?

投稿2021/03/02 03:08

ma2hiro

総合スコア157

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

jinoji

2021/03/02 03:26

そのページをもう少し下の方まで読みましょう。 他ブックのデータを、ブックを開かずに取得する 例)Range("A1") = ExecuteExcel4Macro("'C:\Excel[test.xls]Sheet1'!R1C2") あなたのコードだと、 別ブックのシートの R12C11(つまりK12セル)の値を取得しているのだと思います。
ma2hiro

2021/03/02 04:21 編集

jinojiさん コメント本当にありがとうございます。 勉強不足のため >あなたのコードだと、 >別ブックのシートの R12C11(つまりK12セル)の値を取得しているのだと思います。 が Dat(4) = ExecuteExcel4Macro(PathFileSheet & 12 & "C" & 11) と表している事は分かるのですが  & 12 & "C" & 11 が どうして R12C11(つまりK12セル) となるのでしょうか? どういう語句でググるとその情報にヒットするのかご教示頂けますと幸いです。 &は文字列統合と理解していたのです……
退会済みユーザー

退会済みユーザー

2021/03/02 04:34

& 12 & "C" & 11という記述が意味不明ですが、ExecuteExcel4MacroはR1C1形式での指定しか認められていない可能性があります。 https://www.vba-ie.net/method/executeexcel4macro.php >参照はすべて R1C1 の文字列として指定する必要があります。 そのためR12C11であると推測出来るという事ではないでしょうか。 ちなみにExcel4.0がリリースされたのは1992年にあたり、Microsoftも非推奨の立場ですので該当箇所はご自身で書き直した方が早いと思います。
jinoji

2021/03/02 04:48

msuguruさんのおっしゃる通りです。 最初の例に示した通り、ExecuteExcel4Macroの引数は "'C:\Excel[test.xls]Sheet1'!R1C2" のような形で指定します。 これは、C:\Excel\というフォルダのtest.xlsというファイルのSheet1というシートの1行目の2列という意味になります。 ということから、 PathFileSheet の中には"'C:\Excel[test.xls]Sheet1'!R" というところまで書いてあって、 それに & 12 & "C" & 11 と文字列結合することで "'C:\Excel[test.xls]Sheet1'!R12C11" という文字列を作っているのだろうと推測したまでです。
ma2hiro

2021/03/02 05:14 編集

ありがとうございます。 仰るとおり PathFileSheet には "'C:\Users\hoge\Downloads\重いデータ\評価表.xlsm]fuga'!R" とRが入っていました。 なのでR12C11との事 やっと分かりました。 本当にありがとうございます。 ExecuteExcel4Macro をどう書き直せば良いのか調査中です。 本当にありがとうございました。
jinoji

2021/03/02 05:24

書き直すならきっとこんな感じですかね。 With Workbooks.Open("C:\Users\hoge\Downloads\重いデータ\評価表.xlsm", , True, , , , True) dat(4) = .Worksheets("fuga").Cells(12, 11).Value ' dat(5) = .Worksheets("fuga").Cells(12, 12).Value ’知らんけど他にもあれば一緒に取得 ' dat(6) = .Worksheets("fuga").Cells(12, 13).Value ' ... ' ... .Close False End With
ma2hiro

2021/03/02 05:29

jinojiさん ありがとうございます。 速度を求めているのですがご連絡頂いたように素直にするやり方が一番速度出そうですね…… 他に高速化出来そうな所無いか調査してみます。 コメントありがとうございました。
退会済みユーザー

退会済みユーザー

2021/03/02 05:36 編集

個人的には素直にworkbooks.openで開いて必要な個所を配列に入れたら閉じる方法でいいと思います。 Excelの開く閉じる表示はApplication.ScreenUpdatingで抑制出来ているので処理時間にはさほど影響がありません。 もしファイル数が非常に多かったり書き込み回数が多い時に別の方法を考えましょう。 プログラムの高速化は一番遅い部分を探り当てて高速化して妥協出来る範囲を探った方が苦労が少ないと思います。 私なら範囲内に必要ではないデータが存在しても無視してrange(cells(1,1),cells(EndRow,EndColumn))で一括取得して処理します。 (EndRowとEndColumnの位置は末尾ではなく必要な位置で別途取得してください) Cells(1,1)から始めるのはExcelのR1C1と同じ形で配列を触れるので最初は理解しやすいからです。
ma2hiro

2021/03/05 09:32 編集

msuguruさん コメントありがとうございます。 素直に workbooks.open でやった方が良いとの情報ありがとうございます。 そちらで実装し速度をみてみようかと思います。 多分なんとか動くから良いやと ExecuteExcel4Macroで動作させていたのが重い原因だと思います…… http://www.excel.studio-kazu.jp/kw/20161116132131.html には ◎ADO方式 ◎外部参照数式埋め込み方式 ▲ExecuteExcel4 方式(遅い!) と記載があるのを見つけたため追記いたします。
ma2hiro

2021/03/05 06:36 編集

msuguruさん jinojiさん 仰るようにWorkbooks.openで実装したつもりなのですが 逆に遅くなった気がします…… 大変申し訳無いのですが新規トピに表記したのですがよろしければコメント頂ければ幸いです。
ma2hiro

2021/03/05 06:50

新規トピにするより質問にぶら下げてとの事なのでこちらに表記します。 大変申し訳ございません。 ExecuteExcel4Macroが遅いとの情報を見て代替としてWorkbooks.Openを利用して 以下のように実装したのですが逆に遅くなってしましました…… ```vba : 'PathFileSheet = "'" & strPath & "[" & strFileName & "]" & SheetNames & "'!R" Dim wb As Workbook strTemp = strPath & strFileName Set wb = Workbooks.Open(strTemp) 'FiscalYear = Val(ExecuteExcel4Macro(PathFileSheet & 2 & "C" & 13)) '年度表示 FiscalYear = Val(wb.Sheets(SheetNames).Cells(2, 13).Value) '年度表示 'Dat(1) = ExecuteExcel4Macro(PathFileSheet & 5 & "C" & 5) '実施日 Dat(1) = CLng(wb.Sheets(SheetNames).Cells(5, 5).Value) '実施日 'Dat(2) = ExecuteExcel4Macro(PathFileSheet & 6 & "C" & 5) '店名 Dat(2) = wb.Sheets(SheetNames).Cells(6, 5).Value '店名 With EvaluationSheet '評価表 'Dat(4) = ExecuteExcel4Macro(PathFileSheet & 12 & "C" & 11) '業種 Dat(4) = wb.Sheets(SheetNames).Cells(12, 11).Value '業種 'Dat(5) = ExecuteExcel4Macro(PathFileSheet & 12 & "C" & 5) '品目 Dat(5) = wb.Sheets(SheetNames).Cells(12, 5).Value '品目 'Dat(7) = ExecuteExcel4Macro(PathFileSheet & 9 & "C" & 5) '取引先名カナ(半角)=SubcontractorKana Dat(7) = wb.Sheets(SheetNames).Cells(9, 5).Value '取引先名カナ(半角)=SubcontractorKana : End With ``` 重いExecuteExcel4Macroをコメントアウトしてその下部に代替とするように変更したつもりです…… コレで速度が上がれば良いなと思っていたのですが なんかVBAの画面の書き換えが走っているようで逆に遅くなったような気がします…… コメント頂いた実装方法は上記のやり方で正しいのでしょうか? また実際使用する際にはVBAの画面は出ないのですがVBAの書き換えが走らない実装方法もお教えいただきますと嬉しく思います。 お忙しい所大変申し訳無いのですが上記ご助力頂けないでしょうか?
jinoji

2021/03/05 08:58

処理としては間違ってないと思います。 上でmsuguruさんが書いていた一括取得という考えで行けば Dim wb As Workbook strTemp = strPath & strFileName Set wb = Workbooks.Open(strTemp) ’必要そうな範囲を一括で配列に納めて、ブックは閉じる Dim arr As Variant arr = wb.Worksheets(SheetName).Cells.Resize(12, 13).Value wb.Close SaveChanges:=False FiscalYear = Val(arr(2, 13)) '年度表示 Dat(1) = CLng(arr(5, 5)) '実施日 Dat(2) = arr(6, 5) '店名 Dat(4) = arr(12, 11) Dat(5) = arr(12, 5) Dat(7) = arr(9, 5) みたいな感じだと思います。 (VBAの画面の書き換えという意味がよくわかりませんでした。)
jinoji

2021/03/05 09:05

気になるのは、元のコードの For Col = 1 To 44 のままで 44回参照するブックをOpen/Closeしていないか、ということです。 (仮にTargetRo でもループしてたりするとさらに大変です。) 1回で済ませられるならそうしましょう。
ma2hiro

2021/03/05 09:14

jinojiさん 失礼しました。 仰るとおりですね…… もう少し見てみます。 本当に感謝いたします。
ma2hiro

2021/03/11 07:44 編集

jinoji様 やはり44階ファイルをOpenCloseしていました。 が改修手法を以下のようにしている最中です。 ググってそれとなく出てきた。 [VBAで作ったマクロの高速化②|エクセルブックを開いたり閉じたりする事自体は速くならないことの対策 - ゆんの業務改善ブログ](https://www.mutable.work/entry/2019/09/18/211020) を見てみて同様にすれば良い気がしております。 上記URLでは”まとめ.csv”に ``` If InStr(ファイル名temp, "Sample") <> 0 Then  'エクセルブック上で無く、開く。ナンバー2として。読み込み用として。 Open フォルダpath & ファイル名temp For Input As #2 Do Until EOF(2) 'EOFはEnd of File:ファイルの最後の行という意味。このループの中で一つのファイルを最後まで読み込む Line Input #2, greeting_str '#1を一行読み込んでgreeting_strに格納する Print #1, greeting_str '#1の末尾にgreeting_strを追加する Loop Close #2 'SampleX.csvを閉じる ``` と#1が書き込み用で#にが読み込みデータ用としている気がしますので このように実装してみます…… 他に良いサンプルやページがございましたらお教えいただきますとありがたいです。 こちらで実装してみて速度が改善されましたら解決とさせて頂きます。
ma2hiro

2021/03/11 08:30 編集

jinoji様 ``` Dim wb As Workbook strTemp = strPath & strFileName Set wb = Workbooks.Open(strTemp) 'ちょっと時間がかかる…… ``` を↓のように Open strPath & strFileName For Input As #2 としたいと思っているのですが そうすると ``` FiscalYear = Val(wb.Sheets(SheetNames).Cells(2, 13).Value) '年度表示 ↓ FiscalYear = Val(#2.Sheets(SheetNames).Cells(2, 13).Value) '年度表示 ``` のように実装出来ません…… どのような語句でググると解決方法が出てくるのか伺ってよろしいでしょうか? このトピの趣旨とは離れて来たので新規トピに表記した方が良いのかな……
jinoji

2021/03/11 08:35

アドバイスするにも、もう少し全体像が分からないと難しいので、 ・転記元のExcelファイルは1つなのか複数なのか ・転記先のデータは何行×何列くらいなのか、 ・ざっくりいうと、何をどうしてどうしたい処理なのか ・いまトータル何分くらいの処理時間なのか あたりを説明してみてください。
ma2hiro

2021/03/11 08:58

jinoji様 本当にコメントありがとうございます。 ご返答いたします。 ・転記元のexcelファイルは1つですがシートが100程度ございます。 ・転記先は1シート44列でなので100行程度44列です。 ・ざっくりいうと転記元のシートから値を抽出して転記先にまとめる処理です。 ・今トータルで5分ぐらいの処理時間です。 各シートのセルの情報を抽出して転記先に転記している処理にて現状重すぎるので 高速化をしたくファイルを開いて閉じる作業をどうにかしたいと思っております。 それでファイルOpenの所を Open strPath & strFileName For Input As #2 とすれば早くなるらしいのですがそうすると そのファイルのシートはどのように指定すれば良いのか分からない状態です。 #2.Sheets(SheetNames).Cells(2, 13).Value このように指定出来れば良いと思っておりますが どのような語句でグーグルさんで調査すれば良いのか分からないのです…… 初心者ゆえ拙い説明ですが上記の通りです。 ご助力頂けないでしょうか?
jinoji

2021/03/11 09:17

転記元が1ファイルなら、 「最初に1回開いて、最後に1回閉じる」 もしくは 「最初に1回開いて、必要なデータを変数に取得し、すぐに閉じる」 とすることができるはず。 44回(もしくは4400回?)開いて閉じてを繰り返すのをやめるだけで、 (44倍とまではいわないまでも)相当程度早くなるはず。
ma2hiro

2021/03/12 02:00

jinoji様 ご返答ありがとうございます。 転記元は1ファイルで最初に1回開いて最後に1回閉じるとしています…… ですがシートが100程ありそちらを読み込む際に遅いと感じているので そこを改修したいと思っておりまして以下のようにしております。 ``` '書き込み先はVBAを動作させるエクセル Public Function Main(actWs As Worksheet) As Boolean Dim Dat As Variant '評価データ 'そこのシートが開いているか確認 With actWs : End With '読み込み先ファイルをオープンしてシート名取得 SheetNamesList = ReadSheetNamelist(strPath, strFileName) 実際に読み込んでDat内にデータを入れる For i = 0 To UBound(SheetNamesList) '評価表シートからデータの取得 Dat = ReadData(strPath, strFileName, SheetNamesList(i), EvaluationListType) Next '実際に書き込み With actWs : .Cells(6, 7).Value = ThisWorkbook.RecentRatingDay End With ``` とここまで書いたのですが Dat = ReadData(strPath, strFileName, SheetNamesList(i), EvaluationListType) 内で strTemp = strPath & strFileName Set wb = Workbooks.Open(strTemp) とやっているのでそこが重いです。シート数分こちらを呼んでいるので…… ですので引数でワークブックを渡して何度もOpenしないように実装してみます。 方向性が見えました。 本当にありがとうございました。
ma2hiro

2021/03/12 04:52

Dat = ReadData(strPath, strFileName, SheetNamesList(i), EvaluationListType) を Dim wb As Workbook Set wb = Workbooks.Open(strPath & strFileName) Dat = ReadDataEx2(wb, SheetNamesList(i), EvaluationListType) と毎回Openにしない方法で実装すると早くなりました。 Workbooks.Openはめちゃくちゃ時間がかかるとの情報ありがとうございました。 本当にありがとうございました。
ma2hiro

2021/03/17 07:55

早くなったとの事は勘違いでした…… 今は退会したユーザーさん、jinojiさんのやり方でやってみようとしております。 とりあえず宣言のみ表記しますっ
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問