With ブロックを使わず、というのは、With TargetSheet 〜 End With の中で .Range() をやるよりも、確か Set TargetRange = TargetSheet.Range() とやるほうがトータルでは速かったんじゃないか、ということです。あと、可読性やメンテナンス性で、どちらかが上か、というのもありますが、今回のように二重に With ブロックがあったりすると不利かな、と。
※下記コードを実施するために、
Microsoft Scripting Runtime
Microsoft VBScript Regular Expressions 5.5
を参照設定に追加して下さい。
追加方法:VBE(VBAを書くエディタ)の上のメニューにてツール(T)→参照設定(R)
VBA
1' バグ防止のため変数宣言を強制
2Option Explicit
34' テーブルデータ最新化
5Public Sub measure()
67 ' 変数宣言
8 ' 【コメント】:Integer型は32767までしか入らないので桁あふれリスクがあります。また、Longの方が性能が良いです。
9 Dim i As Long
10 ' 【コメント】:変数名は型が推測できるものが良いです。tmpやbufなどの変数名はなるべく避けるべきです
11 Dim book As Workbook
12 ' 【コメント】:Dim a, b As Doubleという宣言の場合、aはVariant型になってしまっています。Variant型はどんな型でも受け付ける万能型なのでバグの温床となります。使用は最小限にしましょう
13 Dim startTime As Single
14 Dim matchRow As Long
15 Dim targetText As String
16 Dim searchArray As Collection
17 Dim searchText As Variant
18 Dim lastRow As Long
19 Dim fso As FileSystemObject
20 Dim myFile As File
2122 ' 定数宣言
23 Const BOOK_DIR As String = "C:\test"
2425 ' 処理開始時刻を取得
26 startTime = Timer
2728 ' 画面描画などを抑止
29 ApplicationSetting False
3031 ' 検索対象文字列リストを取得
32 ' 【コメント】:検索対象文字列リストは比較的変更が発生しやすいプロシージャだと推測しましたので、プロシージャ分割を実施しました
33 Set searchArray = GetSearchArray
3435 ' オブジェクト取得
36 Set fso = CreateObject("Scripting.FileSystemObject")
3738 ' エラー制御はコーダーの意図しないエラーによる想定外挙動を全て把握するためにもなるべく小さい範囲に留めたエラー制御を実施すべきです
39 ' On Error Resume Next
404142 ' 検索対象ディレクトリの全ファイルを走査
43 For Each myFile In fso.GetFolder(BOOK_DIR).Files
4445 ' 処理対象のブックのみ処理
46 If IsValidBookName(myFile.Name) Then
4748 ' エラー制御開始
49 On Error Resume Next
5051 ' ブックを開く
52 Set book = Workbooks.Open(myFile.Path, ReadOnly:=True)
5354 ' エラー制御終了
55 On Error GoTo 0
5657 ' ブックが開けなかった場合はログ出力
58 If book Is Nothing Then
59 Debug.Print myFile.Path & "を開けませんでした"
60 Else
6162 ' 1シート目を処理
63 With book.Worksheets(1)
6465 ' 全検索対象文字列を走査
66 For Each searchText In searchArray
6768 ' 検索結果初期化
69 matchRow = 0
7071 ' エラー制御開始
72 On Error Resume Next
7374 ' 検索対象文字列を検索
75 matchRow = Application.WorksheetFunction.Match(searchText, .Range("test[id]"), 0)
7677 ' エラー制御終了
78 On Error GoTo 0
7980 ' 検索結果が存在する場合
81 If matchRow <> 0 Then
8283 ' 取得対象文字列を取得
84 targetText = .Cells(matchRow + 1, .Range("test[id]").Column + 1).Text
8586 With ThisWorkbook.Worksheets("sheet5")
8788 ' 検索結果初期化
89 matchRow = 0
9091 ' エラー制御開始
92 On Error Resume Next
9394 ' 検索対象文字列を検索
95 matchRow = WorksheetFunction.Match(searchText, .Range("collect[id]"), 0)
9697 ' エラー制御終了
98 On Error GoTo 0
99100 ' 検索結果が存在する場合
101 If matchRow = 0 Then
102103 ' 追加行取得
104 lastRow = .Cells(.Rows.Count, .Range("collect[id]").Column).End(xlUp).Row + 1
105106 ' 追加行に値設定
107 .Cells(lastRow, .Range("collect[id]").Column).Value = searchText
108 .Cells(lastRow, .Range("collect[id]").Column + 1).Value = targetText
109110 Else
111112 ' 対象行を更新
113 .Cells(matchRow + 1, .Range("collect[id]").Column + 1).Value = targetText
114115 End If
116117 End With
118119 End If
120121 Next
122123 End With
124125 ' ブックを閉じる(保存しない)
126 book.Close False
127128 End If
129130 End If
131132 Next
133134 ' 画面描画などを再開
135 ApplicationSetting True
136137 ' 処理に要した時間を出力
138 Debug.Print "処理に要した時間:" & Timer - startTime & "秒"
139140End Sub
141142' 処理対象のファイルかどうかを判定
143Private Function IsValidBookName(ByRef pFileName As String) As Boolean
144145 ' 変数宣言
146 Dim re As RegExp
147148 ' オブジェクト初期化
149 Set re = CreateObject("VBScript.RegExp")
150151 ' 正規表現パターンを設定
152 With re
153 .Global = True
154 .IgnoreCase = False
155 .Pattern = "^[0-9]+\.(xls|xlsx|xlsm)$"
156 End With
157158 ' 引数のファイル名がExcelファイルか判定
159 If re.Test(pFileName) Then
160 IsValidBookName = True
161 Else
162 IsValidBookName = False
163 End If
164165End Function
166167168' 検索対象文字列リストの取得
169Private Function GetSearchArray() As Collection
170171 ' 変数宣言
172 Dim myCollection As Collection
173174 ' オブジェクトを初期化
175 Set myCollection = New Collection
176177 ' 検索対象を設定
178 With myCollection
179 .Add 111
180 .Add 222
181 .Add 333
182 End With
183184 ' 結果返却
185 Set GetSearchArray = myCollection
186187End Function
188189' Excelアプリケーションの設定(引数がTrueの時に有効とする)
190Private Sub ApplicationSetting(ByRef pEnabled As Boolean)
191192 With Application
193 ' 画面描画の設定
194 .ScreenUpdating = pEnabled
195 ' 警告・確認ダイアログの設定
196 .DisplayAlerts = pEnabled
197 ' イベントのコントール設定
198 .EnableEvents = pEnabled
199 ' 再計算の実施有無設定
200 .Calculation = IIf(pEnabled, xlCalculationAutomatic, xlCalculationManual)
201 End With
202203End Sub
204
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/09/16 05:51
2017/09/16 05:55
2017/09/16 05:58
2017/09/16 06:08
2017/09/16 06:27
2017/09/16 06:32