EXCELVBAの性能改善

EXCELマクロで、ワークシートに文字列を書き込むときの性能についてです。
実際ぶち当たったのですが、なぜか6セル分を書き込むだけで3秒程度かかる事象が起きました。
はっきりとした原因は不明なのですが、おそらくデータのあるセル範囲（アクティブレンジ）が多すぎると、書き込みに時間がかかるようです。
※ScreenUpdatingやAutoCalculate等は当然OFFにして実行しています。

対策として以下のようにしました。

・改修前（遅いパターン）

for i = 1 to 10
for j = 1 to 10
Cells(i,j).value=cstr(i+j)
next j
next i

・改修後

dim values(10,10) as variant
for i = 0 to 9
for j = 0 to 9
 values(i,j) = cstr(i+j)
next j
next i

Range(Cells(1,1),Cells(10,10)).value2 = values

改修後は、毎回セルに値を設定するのではなく、２次元配列に値を設定しておき、配列をセル（レンジ）に一回で設定する。というものになります。

これにより性能が約１００倍くらい早くなりました。（※処理によります）
推測ですが、WorkSheetオブジェクトのCellsプロパティやRangeプロパティは実は時間がかかる処理なのかもしれません。索引を使っているだろうから早いと思っていたのに…。

EXCELでタグ付き正規表現

サクラエディタでタグ付き正規表現ができないみたい。
秀丸ならできるのにな。
探してみたらEXCELでできるみたいなので、拝借。

' 正規表現による置換
Function RegReplace(ByRef strSource As String, _
　　　　　　　　　　ByRef strPattern, _
　　　　　　　　　　ByRef strReplacement As String) As String


　　'動作環境： IE5.0以上がインストールされていること
　　'参照設定： Microosft VBScript Regular Expressions x.x

　　Dim REG As REGEXP
　　Set REG = New REGEXP
　　With REG
　　　　.Pattern = strPattern
　　　　.IgnoreCase = False
　　　　.Global = True
　　　　RegReplace = .Replace(strSource, strReplacement)
　　End With
　　Set REG = Nothing

End Function

秀丸使えないときはこれを使うしかない。


訂正。サクラエディタでも使えるみたいです。

EXCELワークブックの目次を作る

仕事してるとEXCELのシートが大量に作られてるドキュメントをよく見る。
シートを移動するのがめんどくさいので、目次を作るマクロを作ってみた。

'ﾊｲﾊﾟｰﾘﾝｸ表紙作成------------------------------------------
Sub CreateCoverPage()
     '例外処理
 On Error GoTo Exception
    'Define
 Dim objApp As Application
 Dim objWB As Workbook
 Dim objWS As Worksheet
 Dim sCnt As Integer         'シート数
 Dim sHyper() As String      'シート名ハイパーリンク文字列配列
 Dim I As Integer          'ループ用
 Dim rVis As range           '非表示確認用
     'Instance
 Set objApp = Application
     '表示の変更
 objApp.DisplayAlerts = False
 objApp.ScreenUpdating = False
 objApp.Cursor = xlWait
     'ﾌｧｲﾙｵｰﾌﾟﾝ
 Set objWB = ActiveWorkbook
 'ｼｰﾄ数ｹﾞｯﾄ
 sCnt = objWB.Sheets.Count
     '配列にハイパーリンクアドレスを作成
 ReDim sHyper(sCnt - 1)
 For I = 0 To sCnt - 1
     sHyper(I) = objWB.Sheets(I + 1).name
 Next
     '表紙シート作成
 Set objWS = objWB.Sheets.Add(Before:=objWB.Sheets(1))

 On Error Resume Next     'シート名が重複しても処理を続ける
 objWS.name = "目次"
 On Error GoTo Exception
    '既存シートのシート名をハイパーリンクとして表紙に記述
 For I = 1 To sCnt
     objWS.Cells(I + 3, 2).Select    'シート名記述はB4から下へ
     objWS.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
         "'" & sHyper(I - 1) & "'!A1", TextToDisplay:=sHyper(I - 1)
 Next

 With objWS         'シートタブの色
     .Tab.ColorIndex = 50
             '結合
     .range("B1:C1").Merge
     .range("D1:G1").Merge
             '補足表示
     .range("B1").Value = "ブック名　：　[" & objWB.name & "]"
     .range("D1").Value = "目次作成日：" & CStr(Now)
     .range("B3").Value = "シート名"
     .range("C3").Value = "説明"
     .range("D3").Value = "作成日"
     .range("E3").Value = "作成者"
             '太字・アライン
     .range("B1:D1").Font.Bold = True
     .range("B3:E3").Font.Bold = True
     .range("B3:E3").HorizontalAlignment = xlCenter
             '表示形式
     .Columns("D:D").NumberFormatLocal = "yyyy/m/d"
             '色をつける
     .range("B1").Characters(Start:=7).Font.ColorIndex = 53
     .range("B3:E3").Interior.ColorIndex = 40
     .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Interior.ColorIndex = 35
             'カラムサイズを設定する
     .Columns("A:A").ColumnWidth = 2
     .Columns("B:B").EntireColumn.AutoFit
     .Columns("C:C").ColumnWidth = 58.13
     .Columns("D:D").ColumnWidth = 11.5
             '罫線
     With .range("B3:E3").Borders(xlEdgeTop)
         .LineStyle = xlContinuous
         .Weight = xlMedium
         .ColorIndex = xlAutomatic
     End With
     With .range("B3:E3").Borders(xlEdgeBottom)
         .LineStyle = xlContinuous
         .Weight = xlMedium
         .ColorIndex = xlAutomatic
     End With        
      With .range("B3:E3").Borders(xlEdgeLeft)
         .LineStyle = xlContinuous
         .Weight = xlMedium
         .ColorIndex = xlAutomatic
     End With        
      With .range("B3:E3").Borders(xlEdgeRight)
         .LineStyle = xlContinuous
         .Weight = xlMedium
         .ColorIndex = xlAutomatic
     End With        
      With .range("B3:E3").Borders(xlInsideVertical)
         .LineStyle = xlContinuous
         .Weight = xlMedium
         .ColorIndex = xlAutomatic
     End With        
      With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlEdgeTop)
         .LineStyle = xlContinuous
         .Weight = xlMedium
         .ColorIndex = xlAutomatic
     End With        
      With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlEdgeBottom)
         .LineStyle = xlContinuous
         .Weight = xlMedium
         .ColorIndex = xlAutomatic
     End With        
      With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlEdgeLeft)
         .LineStyle = xlContinuous
         .Weight = xlMedium
         .ColorIndex = xlAutomatic
     End With        
      With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlEdgeRight)
         .LineStyle = xlContinuous
         .Weight = xlMedium
         .ColorIndex = xlAutomatic
     End With        
      With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlInsideVertical)
         .LineStyle = xlContinuous
         .Weight = xlThin
         .ColorIndex = xlAutomatic
     End With        
      If sCnt <> 1 Then
         With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlInsideHorizontal)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
         End With        
      End If
       End With
 Exit Sub

Exception:     'Dispose
 Set objApp = Nothing
 Set objWB = Nothing
  Set objWS = Nothing
     '削除確認ダイアログを出す
 Application.DisplayAlerts = True
 Application.Visible = True
 Application.Cursor = xlDefault

 MsgBox "エラーが発生しました" & vbCrLf & _
        "エラー番号：" & Err.Number & " エラー詳細：" & Err.Description _
        , vbExclamation, "システム"
 End Sub

こんな感じのができます。

そして目次にジャンプするマクロ（これがないとあんまり意味ない）
また次回。

VBAからVBAのコード編集

マクロを仕込んだブックを使っていて、古いコードを一括で編集したいときがあります。

そんなときは、コードを編集するマクロを書いてやればいいのです。

ここでは簡単な編集をメモっときます。

ヘルプを見るとわかるけど、プロシージャ作ったりなんかもできるみたい。

個人的にはコードをVBAで作っていくより、ファイル読み込ませるほうが確実で早いと思うんだけど。。。

'指定ブックのVBAコード編集する
Public Sub UpdateCode()
Dim path As String
Dim wb As Workbook
Dim tgt_mod As String
Dim in_path As String

'指定ブックのパス
path = "C:\WORK\Target.xls"
'追加したいモジュール名称
tgt_mod = "Module1"
'対象ブックを開く
Set wb = Application.Workbooks.Open(path)

With wb.VBProject.VBComponents(tgt_mod).CodeModule

   '5行目に文字列を挿入する
    .InsertLines 5, "msgbox cstr(5)"

   'テキストファイルから追加する
  in_path = "C:\WORK\input.bas"
  .AddFromFile in_path

    '文字列を追加する
  .AddFromString ("'コメントを追加する")

    'そのモジュール内のコードを削除する
   .DeleteLines 1, .CountOfLines

End With

'対象ブックを保存して閉じる
wb.Save
wb.Close

Set wb = Nothing
End Sub

あとは、対象ブックを探すロジックを入れるだけ。

ただし、コード編集をしたいブックのVBAProjectがロックされてる場合はエラーになります。

ネットを色々調べてみたけど、どうやらVBAからVBAProjectのロック解除はできなさそう。

まぁできたらロックの意味あんまりないよね。

今度からは後々のことを考えて作ります。

※ブックのロック設定・解除はVBAからもできます。