2010年5月30日日曜日

【Excel】サブフォルダ一覧【VBA】

 対象フォルダのサブフォルダ一覧をワークシートに出力するコード。
Sub MakeFolderList()
    Set sf = CreateObject("Scripting.FileSystemObject").GetFolder("C:\").SubFolders
    Dim x: ReDim x(sf.Count, 1)
    For Each f In sf
        x(i, 0) = f.Name
        i = i + 1
    Next
    Range("A1:A" & sf.Count) = x
End Sub
 対象フォルダを変えたければ"C:\"の所を書き換えればOK。
 もしA1セル以下ではなく、C3セル以下にリストを出力したい場合は、最後の行を"Range("C3:C" & sf.Count + 2) = x"のように書き換えればOK。

 このコードを考えるにあたって、サンプルとして一万個のダミーフォルダを作成・削除したり、処理時間を測定したのが以下。
Public StartTime As Double
Public EndTime As Double
Const TargetFolder = "C:\test"

Sub TimerStart()
    StartTime = Timer
End Sub

Sub TimerStop()
    EndTime = Timer
    MsgBox (EndTime - StartTime & " 秒")
End Sub

Sub MakeDummyFolder()
    Call TimerStart         '---- 測定開始
    Set fs = CreateObject("Scripting.FileSystemObject")
    For i = 0 To 9999
        fs.CreateFolder (TargetFolder & _
                         "\_dummy_" & _
                         Format(i, "0000"))
    Next i
    Set fs = Nothing
    Call TimerStop          '---- 約3.5~10秒
End Sub

Sub MakeFolderListA()
    [A:A].Clear
    Call TimerStart         '---- 測定開始
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set sf = fs.GetFolder(TargetFolder).SubFolders
    i = 1
    For Each f In sf
        Cells(i, 1) = f.Name
        i = i + 1
    Next
    Set sf = Nothing
    Set fs = Nothing
    Call TimerStop          '---- 約0~8秒???
                            'フォルダがなければ当然0秒
End Sub

Sub MakeFolderListB()
    [B:B].Clear
    Call TimerStart         '---- 測定開始
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set sf = fs.GetFolder(TargetFolder).SubFolders
    Dim x As Variant
    ReDim x(sf.Count, 1)  '<-- 配列のリサイズ
    For Each f In sf
        x(i, 0) = f.Name
        i = i + 1
    Next
    Range("B1:B" & sf.Count) = x
    Set sf = Nothing
    Set fs = Nothing
    Call TimerStop          '---- 約0~6秒???
                            'Aより少しだけ速い
End Sub

Sub DeleteFolders()
    Call TimerStart         '---- 測定開始
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set sf = fs.GetFolder(TargetFolder).SubFolders
    For Each f In sf
        If f.Name Like "*_dummy_*" Then
            f.Delete      '<-- ※注意!フォルダ全削除
        End If
    Next
    Set sf = Nothing
    Set fs = Nothing
    Call TimerStop          '---- 約4~10秒
End Sub

2010年5月29日土曜日

月配列R_20100506

 ゴールデンウィーク中にぐちゃぐちゃにいじって、ゴールデンウィークが明けたら割と普通に戻りました。
 普通と言っても、何と比べての普通だよ!って話ですけどw。


 それなりに不満なく使えています。

2010年5月26日水曜日

【速度対決】10万セルに値を書き出す【VBA】

 A1:CV1000(1000行×100列=10万セル)に値を書き出してみます。

Public StartTime As Double
Public EndTime As Double

Sub TimerStart()
    StartTime = Timer
End Sub

Sub TimerStop()
    EndTime = Timer
    MsgBox (EndTime - StartTime & " 秒")
End Sub

Sub Sample01()
    [a1:cv1000].Clear
    Call TimerStart         '---- 測定開始
    For r = 1 To 1000
        For c = 1 To 100
            '-- セルを一つずつ呼び出し
            Cells(r, c) = r
        Next c
    Next r
    Call TimerStop          '---- 約33.8秒
End Sub

Sub Sample02()
    [a1:cv1000].Clear
    Call TimerStart         '---- 測定開始
    '-- 画面の更新を停止
    Application.ScreenUpdating = False
    For r = 1 To 1000
        For c = 1 To 100
            '-- セルを一つずつ呼び出し
            Cells(r, c) = r
        Next c
    Next r
    Application.ScreenUpdating = True
    Call TimerStop          '---- 約21.4秒
End Sub

Sub Sample03()
    [a1:cv1000].Clear
    Call TimerStart         '---- 測定開始
    Dim x(1 To 1000, 1 To 100)
    For r = 1 To 1000
        For c = 1 To 100
            '-- あらかじめ配列に代入
            x(r, c) = r
        Next c
    Next r
    '-- 配列の内容をセルへ一気に書き出し
    [a1:cv1000] = x
    Call TimerStop          '---- 約0.13秒
End Sub

 Sample01ではCells()で各セルに直接アクセス。
 Sample02はSample01と同じコードで画面の更新を停止。
 Sample03ではあらかじめ配列へ代入した後にセルへ一気に書き出しています。
 一番遅いSample01でも、1万セルまでであれば3秒程度で終了しますので、1万セルを境にコードの最適化を考えれば十分かも知れません。

【速度対決】1を100万回足してみる【VBA】

 1を100万回足すコードを少しずつ書き換えて速度比較をしてみました。
 セルのA1:A10000に入力された数字を全て合計する処理を100回繰り返しています。

Public StartTime As Double
Public EndTime As Double

Sub TimerStart()
    StartTime = Timer
End Sub

Sub TimerStop()
    EndTime = Timer
    MsgBox (EndTime - StartTime & " 秒")
End Sub

Sub Syokika()
    [a1:a10000].Clear
    [a1:a10000] = 1
End Sub

Sub Sample01()
    Call Syokika
    Call TimerStart         '---- 測定開始
    For i = 1 To 100
        For Each a In [a1:a10000] '<-- この書き方がNG
            ans = ans + a
        Next
    Next i
    Call TimerStop          '---- 約7秒
    MsgBox Format(ans, "#,###")
End Sub

Sub Sample02()
    Call Syokika
    Call TimerStart         '---- 測定開始
    For i = 1 To 100
        '-- 代入を使うだけで速度が15倍
        x = [a1:a10000]
        For Each a In x
            ans = ans + a
        Next
    Next i
    Call TimerStop          '---- 約0.45秒
    MsgBox Format(ans, "#,###")
End Sub

Sub Sample03()
    Call Syokika
    Call TimerStart         '---- 測定開始
    '-- 代入を繰り返し文の外に出すとさらに速くなる
    x = [a1:a10000]
    For i = 1 To 100
        For Each a In x
            ans = ans + a
        Next
    Next i
    Call TimerStop          '---- 約0.24秒
    MsgBox Format(ans, "#,###")
End Sub

Sub Sample04()
    Call Syokika
    Call TimerStart         '---- 測定開始
    Set wf = Application.WorksheetFunction
    For i = 1 To 100
        '-- さらにワークシート関数を使ってみる
        ans = ans + wf.Sum([a1:a10000])
    Next i
    Call TimerStop          '---- 約0.045秒!!!
    MsgBox Format(ans, "#,###")
End Sub

Sub Sample05()
    Call Syokika
    Call TimerStart         '---- 測定開始
    Set wf = Application.WorksheetFunction
    '-- さらに配列に代入してみる
    x = [a1:a10000]
    For i = 1 To 100
        ans = ans + wf.Sum(x)
    Next i
    Call TimerStop          '---- 約0.3秒
                            '遅なっとるやんけ_| ̄|○
    MsgBox Format(ans, "#,###")
End Sub

Sub Sample06()
    Call Syokika
    Call TimerStart         '---- 測定開始
    Set wf = Application.WorksheetFunction
    '-- オブジェクトを代入
    Set x = [a1:a10000]
    For i = 1 To 100
        ans = ans + wf.Sum(x)
    Next i
    Call TimerStop          '---- 約0.045秒!!!
    MsgBox Format(ans, "#,###")
End Sub

Sub Sample07()
    Call Syokika
    Call TimerStart         '---- 測定開始
    Set wf = Application.WorksheetFunction
    '-- あるいはアドレスを文字列で代入
    s = "a1:a10000"
    For i = 1 To 100
        ans = ans + wf.Sum(Range(s))
    Next i
    Call TimerStop          '---- 約0.045秒!!!
    MsgBox Format(ans, "#,###")
End Sub

 Sample02とSample03の違いはコードを書いている段階ですぐに気付きそうですが、Sample01のようなコードは僕なんかはついつい気付かずに書いてしまいそうです。
 Sample04はご存知Excel VBA最強のHuck。ワークシート関数の速さは圧倒的です。
 じゃあ配列に代入したSample05ならどうよ?と考えたのですが、逆に遅くなりました。「セルの内容を配列に格納して処理」と、「ワークシート関数」を組み合わせれば最強コンビになるかと思えば然に非ず。(あと、Sample05はExcel2002だと動きましたが、Excel2000だとエラーが出ました。)
 以上のことから、ワークシート関数を活用しつつ範囲を動的に変えたい場合はSample06 or 07のように書けば良い事になります。

2010年5月25日火曜日

【速度対決】Date vs 固定値【VBA】

 Date関数と固定値("2010/05/25")の比較。

Public StartTime As Double
Public EndTime As Double

Sub TimerStart()
    StartTime = Timer
End Sub

Sub TimerStop()
    EndTime = Timer
    MsgBox (EndTime - StartTime & " 秒")
End Sub

Sub Sample01()
    Call TimerStart         '---- 測定開始
    For i = 1 To 1000000
        buf = Date
    Next i
    Call TimerStop          '---- 約0.9秒
End Sub

Sub Sample02()
    Call TimerStart         '---- 測定開始
    For i = 1 To 1000000
        buf = "2010/05/25"
    Next i
    Call TimerStop          '---- 約0.17秒
End Sub

Sub Sample03()
    Call TimerStart         '---- 測定開始
    d = Format(Date, "yyyy/mm/dd")
    For i = 1 To 1000000
        buf = d
    Next i
    Call TimerStop          '---- 約0.17秒
End Sub

 100万回実行させて、
・Date -> 約0.9秒
・固定値 -> 約0.17秒
で固定値の勝ち。これは当たり前かw。
 つまり実際に使用する際は、Sample03のようにループ文の外で一回だけ代入すれば良いと言う事になります。

【速度対決】Date vs Now【VBA】

 速度比較のコードを書いたら、試すのが面白くなってきました。
 VBAのDate関数とNow関数の比較。

Public StartTime As Double
Public EndTime As Double

Sub TimerStart()
    StartTime = Timer
End Sub

Sub TimerStop()
    EndTime = Timer
    MsgBox (EndTime - StartTime & " 秒")
End Sub

Sub Sample01()
    Call TimerStart         '---- 測定開始
    For i = 1 To 1000000
        buf = Date          'yyyy/mm/dd
    Next i
    Call TimerStop          '---- 約0.9秒
End Sub

Sub Sample02()
    Call TimerStart         '---- 測定開始
    For i = 1 To 1000000
        buf = Now   'yyyy/mm/dd hh:mm:ss
    Next i
    Call TimerStop          '---- 約0.7秒
End Sub

Sub Sample03()
    Call TimerStart         '---- 測定開始
    For i = 1 To 1000000
        buf = Left$(Now, 10) 'yyyy/mm/dd
    Next i
    Call TimerStop          '---- 約2.8秒_| ̄|○
End Sub

 100万回実行させて、
・Date -> 約0.9秒
・Now -> 約0.7秒
でNowの勝ち。て言うかどちらも一瞬ですねw。
 もしかしたらLeft$(Now, 10)でDate()より速くなる?と思って試してみましたが、そうは問屋が卸しませんでした。

VBAでコードの実行速度を測定

 コピペして使いまわしやすいようにモジュール化してみた。

 計測したい処理の前で"TimerStart"をコールし、処理が終了したら"TimerStop"をコールする。

Public StartTime As Double
Public EndTime As Double

Sub TimerStart()
    StartTime = Timer
End Sub

Sub TimerStop()
    EndTime = Timer
    MsgBox (EndTime - StartTime & " 秒")
End Sub

Sub Sample01()
    Call TimerStart         '---- 測定開始
    
    '計測対象のコード
    
    Call TimerStop          '---- 測定終了, 結果表示
End Sub
 Sample01を実行したら、当然0秒で終了します。

2010年5月24日月曜日

VBA配列の覚書

 配列の方向をなかなか覚えられないので覚書。

 まずは良い例。

Sub GoodExample()
    
    Dim x(2, 0)
    
    x(0, 0) = "a"
    x(1, 0) = "b"
    x(2, 0) = "c"
    
    Range("A1:A3") = x
    
End Sub
 実行するとA1:A3に'a','b','c'が出力される。

 次に悪い例。

Sub BadExample()
    
    Dim x(2, 0)
    
    x(0, 0) = "a"
    x(1, 0) = "b"
    x(2, 0) = "c"
    
    Range("A1:C1") = x    '←間違い!
    
End Sub

 実行するとA1:C1全てに'a'が出力されてしまう。

2010年5月23日日曜日

コードの表示

 ブログ上でコードを思ったように表示させるのは意外と難しく、なかなか言う事を聞いてくれない。

 この方法がベストなのかどうかは分からないけど、とりあえず、<pre><code>~ソース~</code></pre>のやり方で行くことにした。


 スタイルシートに以下を追加。

pre {
  background-color: #222222;
  color: #33ff99;
  margin-left: 2%;
  margin-right: 5%;
}
code {
  font-family: monospace, serif;
  font-size: 1em;
  line-height: 1.2;
}

昔のマイコン風に黒地に緑文字。

NetFront

 今更だけどアドエスにNetFrontを入れてみた。
 すごく快適。もっと早くに入れれば良かった。

W-zero3から投稿

 W-zero3から投稿をしたことが一度もなかったのでちょっとテスト。

2010年5月19日水曜日

全シートでセルの選択範囲を同期②(Excel VBA)

 標準モジュールへ以下のコードを書く。


Public GlobalCellRange As String
Public GlobalTopRow As Long
Public GlobalTopColumn As Long

Public Sub GetScrollPos()
With ActiveWindow
GlobalTopRow = .ScrollRow
GlobalTopColumn = .ScrollColumn
End With
End Sub

Public Sub SetScrollPos()
With ActiveWindow
.ScrollRow = GlobalTopRow
.ScrollColumn = GlobalTopColumn
End With
End Sub


 WorkBookへ以下のコードを書く。


Private Sub Workbook_Open()
Call GetScrollPos
GlobalCellRange = Selection.Address
End Sub


 WorkSheetへ以下のコードを書く。


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call GetScrollPos
GlobalCellRange = Target.Address
End Sub

Private Sub Worksheet_Activate()
Call SetScrollPos
Range(GlobalCellRange).Select
End Sub


 前回の課題であった「表示されている範囲の同期」は達成。

 今後の課題:ズームも同期出来るようにする。

2010年5月16日日曜日

全シートでセルの選択範囲を同期(Excel VBA)

 標準モジュールへ以下のコードを書く。


Public GlobalCellRange As String


 WorkSheetへ以下のコードを書く。


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
GlobalCellRange = Target.Address
End Sub

Private Sub Worksheet_Activate()
Range(GlobalCellRange).Select
End Sub


 ほぼ同じデータが入力されたシート同士を比較するときに、各シートの同じセルを手動で選択しながら比較する事が(僕の場合は)良くあるので自動化してみた。


 ファイル名を"SelectSync.xls"とでもして、読み取り専用で持っておき、データを比較するときに使い捨てれば良い。


 比較シートを増やしたい場合、シートをコピーすればシート内のコードもコピーされるため、各シートにちまちまと同じコードをコピペする必要はない。


 今後の課題:シート切替時に、同一セルを選択するだけでなく、アクティブセル、表示されている範囲まで同期できれば、なお使い易いと思われる。

キーカスタマイズ 右一個ずらし

 キーボードの右手エリアをまるごと右に一つずらします。

 配列好きには結構メジャーなカスタマイズのようです。

 最近、僕もこのカスタマイズに手を出しました。
(最近と言っても2月14日だったようですw)



 最初は案①のように、右端のキーをまるごとキーボードの真ん中に移動してみました。

 結構快適だったのですが、¥と[ ]が打ちにくくてストレスを感じました。

 で、昨日思いついたのが案②です。

 使用頻度から言っても案②の方が妥当と思われます。

 しばらくはこれで行ってみようと思います。

2010年5月1日土曜日

月配列R_20100501(やりすぎ?w)

 変更しすぎてまともに打てません。_| ̄|○



 数値上の成績は確実に悪くなっています。でも、自分の手には馴染むはず。多分w。

 向こう3年打ちやすければいいや、と言う軽いノリで設計中。

 wをシフトキーにしたのは、www <- これをスムーズに打つためw。

 おk <- これをスムーズに打つために、"o = お"は外せない。日常で、最も高速入力が要求されるのは実はチャットだったりするのでw、上記「草」と併せてチャット対策是重要。

 出来る限り多くの環境で使えるようにと、アルファベットキー以外は使わない方針でしたが、今回、"; = を"と"d, = ゃ"で記号キーを使いました。

 "ly = び"は、ちょっと無茶してるかも知れない。でも"ly"は英文で割とよく出てくる運指なので、普段鍛錬しておく価値アリと言う事でヨシとする。

 "ce = せい"もキツイ運指。でも、英文で"ce"は頻出だし、人差し指と中指を使って運指を最適化すれば速く打てるのでヨシとする。

 "yu = ひと"もキツイ運指。でも、ローマ字入力で鍛えられている運指なのでヨシとする。