tkenの備忘録その他: 2010

2010年12月25日土曜日

2010年11月27日土曜日

2010年11月18日木曜日

　色が付くとはっきり分かりますが、どうやら文字入力の占める割合は僅かのようです。

　仕事では正確さが求められるため、打った方が早い文字列でも出来る限りコピペするよう心がけているからでしょう。

　CtrlとEnterがすごい量ですが、全てを小指で打っているわけではありません。

　仕事中はカーソルキーの位置に右手を置いて、Ctrlは右手親指、Enterは右手人差し指で打つことが多いです。

　特に意識してそうしている訳ではないのですが、自然と強い指を多用しているようです。

2010年11月16日火曜日

第２のホームポジション

　ホームポジションと言えば、通常は左右の人差し指をそれぞれＦとＪに置いたポジションの事を言います。

　通常も何もそれで正解なのですが、仕事中に僕が最も長く手を置いているのは実は先述のＦ・Ｊのポジションではありません。

　写真は会社のＰＣです。

　ちょっとピンぼけしてますが、「→」キーの上が派手に擦り切れているのが分かると思います。

　ここが僕の仕事中のホームポジションであり、擦り切れている位置に常に右手の薬指を引っ掛けておき、周辺キーのそこからの相対位置を体が憶えていると言う具合です。

　新しいキーボードが支給されると、キートップよりも何よりも真っ先にこの部分がテカテカになってしまいます。

2010年11月3日水曜日

Vim on Colemak

　配列いじりに手を染めて以来、ViとEmacsは、すっかりご無沙汰になっていました。

　しかし、設定ファイルをパッと開いて「１」を「０」に書き換えてサッと閉じる、みたいな時は、やっぱりViが早いです。

　ColemakはQwertyとはアルファベットの並びが違うので、Colemak上でVi(Vim)を使うとなると、当然キーバインドを変更する必要があります。

　もちろん、キーバインドを変更せずに強引にねじ伏せる事も可能なのですが、Vi(Vim)を使う意味がなくなってしまうでしょう。

　そんな訳で、Vi(Vim)のキーバインドも「俺様」で行きます。

　以下_vimrcをさらさらしてみるテスト。

"####キーバインド(undo)####

noremap <c-u> u

"####キーバインド(削除)####

noremap k d

"####キーバインド(移動系)####

noremap h <Left>
noremap n <Down>
noremap e <Up>
noremap i <Right>

noremap a <Home>
noremap d <End>

noremap s b
noremap t w

noremap O <PageUp>
noremap o <PageDown>

"####キーバインド(挿入系)####

noremap u i
noremap U a
noremap l I
noremap L A
noremap y o
noremap Y O

noremap f c
noremap F C

"####コピー＆ペースト####

noremap c y
noremap v p
noremap V P

2010年10月27日水曜日

ハイフンは右小指下段

　日本語入力に俺様カスタマイズのカナ入力を使っているのですが、その中では特に長音記号を定義していません。ローマ字入力と同じようにハイフンを使って入力しています。

　とは言え、長音記号が右小指最上段ではあまりに苦しいので、右小指下段へ移動しました。

　「・」「？」と入れ替えた格好ですが、丁度「！」と「？」が左右対称位置となり、これは結構気に入っています。

　また、長音記号の近くなので感覚的に覚えやすいと考えて、「～」を右小指中段の外側に置きました。「＾」の位置としては良すぎるのかも知れませんが…。

カギ括弧はどう打つ？

　僕は「」を先に打って確定してしまい、カーソルキーで一つ戻ってから「」の中身を書くのが好きです。

　「おはよう！」みたいな短いものは、一気に閉じカッコまで打ち切ってしまいますが、カギ括弧の中身が頭の中で未推敲である場合は、「」をまず確定し、それからゆっくりと中身を考える事が多いです。

　と言う事で、「[」「]」（ややこしいな…）を右手と左手の間に縦に配置してみました。

　打つ時は、左手の中指と人差し指でタタンと真ん中の２キーを打って、右手のエンターキーで確定すると言う寸法です。

現在の俺様配列をさらさらしてみる②

　変換キーでfenrir起動。

2010年10月24日日曜日

現在の俺様配列をさらさらしてみる

　いじった場所（特殊定義）を色分けしています。

　実際には、右手の受け持ち範囲は全て右に一個ずらしているので、その部分も特殊定義と言えなくもないのですが、右手の位置を右に一個ずらしてしまえば感覚的には同じように打てると言う事で特に色分けはしていません。

2010年10月23日土曜日

Colemak!!!Colemak!!!

http://colemak.com/

　配列図を眺めていたら、やたらとテンションが上がってきて抑えられなくなりました。

　これはやるしかない！

　しかし、ググッてみた限りでは、日本でColemakを使っている人はどうやら少ないみたいです。

　2chハードウェア板のキーボードスレにちらりと書き込んでいる方はいました。この方はColemak＋月配列の使い手のようでした。

　配列スレに書き込んで聞いてみたのですが、「俺使ってるよ！」と言う書き込みは今のところありません。しかし即座に反応が返って来るあたりは流石ですｗ。

　Dvorakを使っている人は多いです。

　DvorakJP、ACT、JLOD等、Dvorakで日本語入力をする方法が確立しているからでしょう。

　しかし、残念ながらColemakには、それがありません。

　故に、先程の方のように、Colemak＋月配列のような使い方になるのでしょう。

　僕は英語はさっぱり分からないので、日常で「英文」を打つ機会はありません。

　しかし、「英単語」は結構な頻度で打っていると思います。

　音楽とか映画とか、機材、フリーウェア、そういったものをWebで検索する時は、しばしば英単語を直接タイプしますし、仕事でも、日本語の文章に混じって英単語は結構な頻度でタイプします。

　つまり、僕のように英語が分からなくて、英語と全く縁のない人でも、日常生活の中では結構な頻度で英単語をタイプするのです。

　……いや、あれこれ言いますまい。何を言ってもただ使う理由を探しているだけにしか見えませんｗ。

　要するに使いたいんです！慣れるまでの間、目に見えて生産性が落ちたっていいんです！配列図みてたらテンション上がっちまったんです！

　俺はColemakに凸するぜ！！！（つーかもうしたぜ！ｗ）

忘れるのが難しい

　カナの配置換えをする際、実を言うと、新しい配置を覚えるよりも、旧い配置を忘れる方が難しかったりします。

　覚えるのは気合と根性でなんとかなるのですが、一旦覚えてしまったものは、「さぁ忘れるぞ」と思ったところで忘れられるものではありません。

　特に出現頻度の高いカナの配置を変更した場合が厄介です。

　例えば「い」の位置を変更した場合、「い」のみを打つときは間違えなくても、「ない」を打つときに、旧い「い」の位置をどうしても打ってしまいます。

　「い」の位置だけでなく、「ない」を打つ際の指の形を体がまとめて記憶してしまっているからです。

　実はつい最近「う」と「ん」を入れ替えたばかりで苦しんでいるんですけどね。（；^ω^）

2010年10月17日日曜日

意外と高い「る」の頻度

　出現頻度の高いカナはなるべくアンシフト面に配置した方が総打鍵数が減るので、単純に考えれば入力は楽になるはずです。

　現バージョンのアスナロ配列では、高頻度の「た」をシフト面に配置しており、常々これを改善したいと考えていたのですが、なかなか良いアイデアが浮かびませんでした。

　今回、「た」と「る」では「た」の方が頻度が高かろうと考えて、「た」をアンシフト面へ昇格し、代わりに「る」をシフト面へ降格する手を試みました。

　いざテスト。

　…ヤバイ、「る」って意外と頻度高いよ…＿|￣|○

　おかしいなぁ…と思いつつ、Ｗｅｂで公開して下さっている方々のカナ出現頻度表を検索で引っかかる端から拝見。

　すると、「た」を追い抜き、「か」に次いで堂々の六位に「る」が出現している方がいらっしゃいました。Σ(ﾟдﾟlll)ｶﾞｰﾝ

　うーん、誤解してたなぁ…。「る」の頻度は中の上のちょい上、「き」あたりと同等と考えていたのですが、認識を修正しました。「る」は、どうやらサンプル次第では高順位を占めるカナのようです。

　認識が変わったところで様々なカナ配列を見なおしてみると…、シフトキー押しっぱなしを前提に設計された飛鳥カナ配列を除けば、ほぼ全てのカナ配列が「る」をアンシフト面に配置しています。全然気づかなかった…＿|￣|○

　しかもなんと小梅配列では「る」は人差し指ホームポジションである「Ｆ」の位置です。

　今後は「た＞る」ではなく、「る＞た」の認識で行くことにします。(｀・ω・´)

2010年10月11日月曜日

ワンセグ用の半波長ダイポールアンテナを自作

　まぁ、自作というほどのものではないのだけれど…。

　モノラルイヤホンをぶった切って、割り箸やストローに固定して作る半波長ダイポールアンテナの記事をあちこちで見かけたので、自分でもやってみたくなりました。

　僕の場合は更に横着して、30cm定規に直接セロテープで貼りつけてしまいました。

　アンテナの長さは12.5～15cmくらいで、人によってまちまちのようだったので、電波の出力の弱い東京MXにあわせて15cm弱にしました。

　写真では一見15cmジャストに見えますが、コードをサキイカにしてる時に被覆のビニールが伸びてしまったので、中の線は多分15cm弱です。

アスナロ配列

　別に新配列と言う訳ではなく、今まで月配列Ｒと呼んでいたものを「アスナロ配列」と呼ぶ事にしただけです。

　今まで、月配列４－６９８（幸花配列）を弄って使用している私家版配列の事を仮に「月配列Ｒ」と呼んでいたのですが、ちっとも名が体を表していません。

　２ｃｈ月スレを読む限り、新ＪＩＳの流れを汲まず、且つ、中指シフトを採用している配列は植物の名称が付されるようです。

　幸花配列をベースにしているこの配列は当然、そのカナの配置に於いて新ＪＩＳの影響は受けていません。

　自分ひとりしか使っていないこの配列に名が必要であるかどうかはともかくとして、今後この配列を「アスナロ配列」と呼ぶ事にします。

2010年9月29日水曜日

月配列Ｒ＿２０１００９２９

　今回は、我ながらうまく整理出来たと思う。

　基本的には清音の裏に濁音と半濁音を配置。
　上記規則性からはずれているカナは、青の太罫線で囲っている。

　規則性からはずれているカナのうち、「び」と「ぴ」、「ぶ」と「ぷ」、「ぼ」と「ぽ」は、感覚的に記憶しやすいように、それぞれ指の動きが左右対称になるよう配置し、且つ、濁音か半濁音のどちらかが清音の裏に来るようにしている。

2010年9月23日木曜日

月配列Ｒ＿２０１００９２３

2010年9月20日月曜日

月配列Ｒ＿２０１００９２０

2010年9月18日土曜日

月配列Ｒ＿２０１００９１５～１７

　どうやら連休に入ると配列をがんがん入れ替えてしまうみたいです。
　上が９／１７、下が９／１５。

　okでおｋが打てなくなったのはやや無念。
でも、どうしても濁点をアンシフト面に配置してみたかったので、「お」には一旦シフト面へ退いてもらうことにします。

2010年9月3日金曜日

月配列Ｒ＿２０１００９０３

　ほぼ４ヶ月ぶりの配列変更。

　「の」「れ」「を」を移動。

2010年7月10日土曜日

ファンが止まっていたらしい。しかも数年Σ(´∀｀；)

　もう随分長いこと我が家のリビングで頑張ってくれているThinkPad A31P。

　最近、キーボードの左のあたりが熱くなって落ちるようになったので、キーボードを外してみたら埃がぎっしりΣ(´∀｀；)。

　ファンの外し方がいまいち良く分からなかったので、外さずに掃除機と綿棒とピンセットを駆使して埃を取り除きました。

　祈りつつ電源ON。

　見事起動(∩´∀｀)∩。

　しかも、今まで全然鳴る事のなかったファンの風切音がします。

　…そう言えば数年前、ファンの音が急にうるさくなって、「ヤバイ、壊れたかな？」と思っていたら、いつの間にか静かになって、「あ、治ったんだ、良かった良かった。」と思ったことがありました。

　今考えると、治ったのではなくて埃が詰まってファンが回らなくなっただけのようです。

　しかもその後、数年止まったまま！！！(笑)

　いやはや、良く壊れずにもってくれたものです。

　さすがに、埃を取り除いた直後は、排気口からなにやら黒いスス状の汚れが吹き出してきました。

　教訓：冷却ファンの掃除は定期的に行なったほうが良さそうです。

2010年6月27日日曜日

【Excel】5,461 要素より大きな配列を返すと…【VBA】

　VBA中でワークシート関数を使用する際に、どういう条件で発生しているのかいまいち分からないエラーがあったのですが、やっと分かりました。

XL2000: カスタム関数で 5,461 要素より大きな配列を返すとエラー「#VALUE!」！マクロの実行後のエラー

…と言う事のようです。

　狭い範囲を与えた場合には正常動作するのに、範囲を広げるとエラーが出るのに気付いて、いろいろな範囲を与えながら試していたら、5,461行目を超えた所でエラーが出たので、「5461 excel」でググったら上記サイトに辿り着きました。

Sub HowToUse()
    [a1:b5461].Select
    '[a1:b5462].Selectだと型不一致エラーが出る
    
    t = Timer

    DecreaseRight(Selection).Select
    
    Application.StatusBar = _
        "処理時間 " & Timer - t & " 秒"

End Sub

Function DecreaseRight(a1 As Range) As Range
    
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    Set f = Application.WorksheetFunction
    
    NewColumn = c1
    For c = c2 To c1 Step -1
        
        'Set x = Range(Cells(r1, c), Cells(r2, c))
        Let x = Range(Cells(r1, c), Cells(r2, c))
        If f.CountA(x) > 0 Then
            NewColumn = c
            Exit For
        End If
        
    Next c

Debug.Print TypeName(x)
'Set x だとRange、Let x だとVariant()
'Variant()の場合要素数5,462以上でエラーが出る(XL2K)

    Set f = Nothing
    
    Set DecreaseRight = _
        Range(Cells(r1, c1), Cells(r2, NewColumn))

End Function

　まぁ、いつまでExcel2000使ってるつもりだよ！と言う話なんですけどねｗ。

2010年6月20日日曜日

【Excel】無駄な選択範囲を縮める⑥【VBA】

大量の閉じカッコで終端されて、なんだかLispっぽくなってる箇所とかありますが、とりあえず動くのでいいでしょう。

Function DecreaseRange(a1 As Range) As Range
    
    Set DecreaseRange = _
            DecreaseLeft( _
            DecreaseRight( _
            DecreaseUpper( _
            DecreaseBottom( _
            DecreaseToUsedRange(a1)))))

End Function


Function DecreaseToUsedRange(a1 As Range) As Range
    
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    With ActiveSheet.UsedRange
        ur1 = .Row
        uc1 = .Column
        ur2 = .Rows.Count + ur1 - 1
        uc2 = .Columns.Count + uc1 - 1
    End With
    
    b = (r1 > ur2) Or (c1 > uc2) Or _
        (r2 < ur1) Or (c2 < uc1) Or _
        (ur2 = 1) Or (uc2 = 1)
    If b Then
        
        'UsedRangeの外側が与えられた場合の処理
        '左上隅のセルを返す
        
        NewRow1 = r1
        NewColumn1 = c1
        NewRow2 = r1
        NewColumn2 = c1
        
    Else
    
        'UsedRangeの内側が与えられた場合の処理
        
        If r1 < ur1 Then
            NewRow1 = ur1
        Else
            NewRow1 = r1
        End If
        
        If c1 < uc1 Then
            NewColumn1 = uc1
        Else
            NewColumn1 = c1
        End If
        
        If r2 > ur2 Then
            NewRow2 = ur2
        Else
            NewRow2 = r2
        End If
        
        If c2 > uc2 Then
            NewColumn2 = uc2
        Else
            NewColumn2 = c2
        End If
        
    End If
    
    Set DecreaseToUsedRange = _
        Range(Cells(NewRow1, NewColumn1), _
              Cells(NewRow2, NewColumn2))
              
End Function


Function DecreaseBottom(a1 As Range) As Range
    
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    NewRow = r1
    For c = c1 To c2
        
        If Len(Cells(r2, c)) > 0 Then
            NewRow = r2
            Exit For
        End If
        
        r = Cells(r2, c).End(xlUp).Row
        If r > NewRow Then
            NewRow = r
        End If
        
    Next c

    Set DecreaseBottom = _
        Range(Cells(r1, c1), Cells(NewRow, c2))

End Function


Function DecreaseUpper(a1 As Range) As Range
    
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    Set f = Application.WorksheetFunction
    
    NewRow = r2
    For r = r1 To r2
        Set x = Range(Cells(r, c1), Cells(r, c2))
        If f.CountA(x) > 0 Then
            NewRow = r
            Exit For
        End If
    Next r
    
    Set f = Nothing
    
    Set DecreaseUpper = _
        Range(Cells(NewRow, c1), Cells(r2, c2))

End Function


Function DecreaseRight(a1 As Range) As Range
    
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    Set f = Application.WorksheetFunction
    
    NewColumn = c1
    For c = c2 To c1 Step -1
        Set x = Range(Cells(r1, c), Cells(r2, c))
        If f.CountA(x) > 0 Then
            NewColumn = c
            Exit For
        End If
    Next c
    
    Set f = Nothing
    
    Set DecreaseRight = _
        Range(Cells(r1, c1), Cells(r2, NewColumn))

End Function


Function DecreaseLeft(a1 As Range) As Range
    
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    Set f = Application.WorksheetFunction
    
    NewColumn = c2
    For c = c1 To c2
        Set x = Range(Cells(r1, c), Cells(r2, c))
        If f.CountA(x) > 0 Then
            NewColumn = c
            Exit For
        End If
    Next c
    
    Set f = Nothing
    
    Set DecreaseLeft = _
        Range(Cells(r1, NewColumn), Cells(r2, c2))

End Function

【2011/06/01追記】
　DecreaseToUsedRange関数で、一行目のみ或いは一列目のみを選択した際にA1セルのみを返してしまうと言うバグを発見。「ur2 = 1」と「uc2 = 1」と言う判定ロジックがまずかった。判定ロジックを「a1.Address = "A1"」に変えればOK。修正版のコードは後日…(^_^;)

2010年6月19日土曜日

【Excel】無駄な選択範囲を縮める⑤【VBA】

　無駄な選択範囲を縮める関数として、

・ReduceRangeR -> 下方の無駄な選択範囲を縮める
・ReduceRangeC -> 右方の無駄な選択範囲を縮める
・xUsedRange -> "UsedRange"の外側の範囲を縮める

を定義しました。

　上記三つを更にまとめて、関数"ReduceRange"を定義します。

Sub HowToUse()
    ReduceRange(Selection).Select
End Sub

Function ReduceRange(a1 As Range) As Range
    'ただ単に三つの関数を束ねるだけの関数
    'xUsedRangeを最初に適用すると最も効率が良い(多分)
    Set ReduceRange = ReduceRangeR(ReduceRangeC(xUsedRange(a1)))
End Function

Private Function xUsedRange(a1 As Range) As Range
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    With ActiveSheet.UsedRange
        ur1 = .Row
        uc1 = .Column
        ur2 = .Rows.Count + ur1 - 1
        uc2 = .Columns.Count + uc1 - 1
    End With
    
    If (r1 > ur2) Or (c1 > uc2) Or (r2 < ur1) Or (c2 < uc1) Or (ur2 = 1) Or (uc2 = 1) Then
        'UsedRangeの外側が与えられた場合の処理
        '(左上隅のセルを返す)
        NewRow1 = r1
        NewColumn1 = c1
        NewRow2 = r1
        NewColumn2 = c1
        
        GoTo xxx
    End If
    
    If r1 < ur1 Then
        NewRow1 = ur1
    Else
        NewRow1 = r1
    End If
    
    If c1 < uc1 Then
        NewColumn1 = uc1
    Else
        NewColumn1 = c1
    End If
    
    If r2 > ur2 Then
        NewRow2 = ur2
    Else
        NewRow2 = r2
    End If
    
    If c2 > uc2 Then
        NewColumn2 = uc2
    Else
        NewColumn2 = c2
    End If
    
xxx:
    Set xUsedRange = Range(Cells(NewRow1, NewColumn1), Cells(NewRow2, NewColumn2))
End Function

Private Function ReduceRangeC(a1 As Range) As Range
    r1 = a1.Row
    c1 = a1.Column
    r2 = a1.Rows.Count + r1 - 1
    c2 = a1.Columns.Count + c1 - 1
    
    Set f = Application.WorksheetFunction
    
    NewColumn = c1
    For c = c2 To c1 Step -1
        If f.CountA(Range(Cells(r1, c), Cells(r2, c))) > 0 Then
            NewColumn = c
            Exit For
        End If
    Next c
    
    Set ReduceRangeC = Range(Cells(r1, c1), Cells(r2, NewColumn))
End Function

Private Function ReduceRangeR(a1 As Range) As Range
    r1 = a1.Row
    c1 = a1.Column
    r2 = a1.Rows.Count + r1 - 1
    c2 = a1.Columns.Count + c1 - 1
    
    NewRow = r1
    For c = c1 To c2
        If Len(Cells(r2, c)) > 0 Then
            NewRow = r2
            Exit For
        End If
        r = Cells(r2, c).End(xlUp).Row
        If r > NewRow Then
            NewRow = r
        End If
    Next c

    Set ReduceRangeR = Range(Cells(r1, c1), Cells(NewRow, c2))
End Function

　コードの分かりにくそうな所にコメントを少々追加。
　ついでに、"Exit For"を使うべきところで"GoTo"を使っていた箇所を修正。

　実行前

　実行後

xUsedRange
　黄、紫、青の部分までサイズを縮小

ReduceRangeC
　黄、紫の部分までサイズを縮小

ReduceRangeR
　黄の部分までサイズを縮小

　ここまで来ると、上方と左方の空白部分も最適化したくなってきます。

　要らないような気もするけど…。

【Excel】無駄な選択範囲を縮める④【VBA】

　再チャレンジ。

　"UsedRange"よりも大きな範囲が与えられた場合に"UsedRange"よりも外側の範囲を除いた"Range"を返す関数です。

Sub HowToUse()
    xUsedRange(Selection).Select
End Sub

Private Function xUsedRange(a1 As Range) As Range
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    With ActiveSheet.UsedRange
        ur1 = .Row
        uc1 = .Column
        ur2 = .Rows.Count + ur1 - 1
        uc2 = .Columns.Count + uc1 - 1
    End With
    
    If (r1 > ur2) Or (c1 > uc2) Or (r2 < ur1) Or (c2 < uc1) Or (ur2 = 1) Or (uc2 = 1) Then
        NewRow1 = r1
        NewColumn1 = c1
        NewRow2 = r1
        NewColumn2 = c1
        
        GoTo xxx
    End If
    
    If r1 < ur1 Then
        NewRow1 = ur1
    Else
        NewRow1 = r1
    End If
    
    If c1 < uc1 Then
        NewColumn1 = uc1
    Else
        NewColumn1 = c1
    End If
    
    If r2 > ur2 Then
        NewRow2 = ur2
    Else
        NewRow2 = r2
    End If
    
    If c2 > uc2 Then
        NewColumn2 = uc2
    Else
        NewColumn2 = c2
    End If
    
xxx:
    Set xUsedRange = Range(Cells(NewRow1, NewColumn1), Cells(NewRow2, NewColumn2))
End Function

　"UsedRange"の外側が与えられた場合は、その範囲の左上隅のセル一個を範囲として返す仕様にしました。
【2011/06/01追記】
　xUsedRange関数で、一行目のみ或いは一列目のみを選択した際にA1セルのみを返してしまうと言うバグを発見。「ur2 = 1」と「uc2 = 1」と言う判定ロジックがまずかった。判定ロジックを「a1.Address = "A1"」に変えればOK。修正版のコードは後日…(^_^;)

2010年6月16日水曜日

【Excel】無駄な選択範囲を縮める③【VBA】

　"UsedRange"よりも大きな範囲が与えられた場合に"UsedRange"よりも外側の範囲を除いた"Range"を返す関数です。
　2010年6月13日日曜日と2010年6月14日月曜日のコードを実行する前にこのコードを実行すれば、データの有無を調べる範囲が縮まって、更なる高速化が望めるはずです。

Sub HowToUse()
    xUsedRange(Selection).Select
End Sub

Private Function xUsedRange(a1 As Range) As Range
    With a1
        r1 = .Row
        c1 = .Column
        r2 = .Rows.Count + r1 - 1
        c2 = .Columns.Count + c1 - 1
    End With
    
    With ActiveSheet.UsedRange
        ur1 = .Row
        uc1 = .Column
        ur2 = .Rows.Count + ur1 - 1
        uc2 = .Columns.Count + uc1 - 1
    End With
    
    If ur1 = 1 Then
        NewRow1 = 1
    ElseIf r1 < ur1 Then
        NewRow1 = ur1
    Else
        NewRow1 = r1
    End If
    
    If uc1 = 1 Then
        NewColumn1 = 1
    ElseIf c1 < uc1 Then
        NewColumn1 = uc1
    Else
        NewColumn1 = c1
    End If
    
    If ur2 = 1 Then
        NewRow2 = 1
    ElseIf r2 > ur2 Then
        NewRow2 = ur2
    Else
        NewRow2 = r2
    End If
    
    If uc2 = 1 Then
        NewColumn2 = 1
    ElseIf c2 > uc2 Then
        NewColumn2 = uc2
    Else
        NewColumn2 = c2
    End If
    
    Set xUsedRange = Range(Cells(NewRow1, NewColumn1), Cells(NewRow2, NewColumn2))
End Function

【2010年6月19日土曜日追記】
実はこのコード、"UsedRange"の外側の範囲を与えられたときにうまく動作しないと言う不具合があります。解決法は目下思案中…。

2010年6月15日火曜日

【Excel】半角と全角の変換マクロ⑧【VBA】

　要するにやりたかったのはこれです。

　セルを全選択しても、数十万個のデータに対して処理をかけても、数秒で完了します。

Sub 全角に変換する()
    t = Timer
    Call xStrConv(ReduceRangeR(ReduceRangeC(Selection)), vbWide)
    Application.StatusBar = "　全角に変換しました。 " _
                            & Timer - t & " 秒"
End Sub

Sub 半角に変換する()
    t = Timer
    Call xStrConv(ReduceRangeR(ReduceRangeC(Selection)), vbNarrow)
    Application.StatusBar = "　半角に変換しました。 " _
                            & Timer - t & " 秒"
End Sub

Private Function ReduceRangeC(a1 As Range) As Range
    r1 = a1.Row
    c1 = a1.Column
    r2 = a1.Rows.Count + r1 - 1
    c2 = a1.Columns.Count + c1 - 1
    
    Set f = Application.WorksheetFunction
    
    NewColumn = c1
    For c = c2 To c1 Step -1
        If f.CountA(Range(Cells(r1, c), Cells(r2, c))) > 0 Then
            NewColumn = c
            GoTo xxx
        End If
    Next c
xxx:
    
    Set ReduceRangeC = Range(Cells(r1, c1), Cells(r2, NewColumn))
End Function

Private Function ReduceRangeR(a1 As Range) As Range
    r1 = a1.Row
    c1 = a1.Column
    r2 = a1.Rows.Count + r1 - 1
    c2 = a1.Columns.Count + c1 - 1
    
    NewRow = r1
    For c = c1 To c2
        If Len(Cells(r2, c)) > 0 Then
            NewRow = r2
            GoTo xxx
        End If
        r = Cells(r2, c).End(xlUp).Row
        If r > NewRow Then
            NewRow = r
        End If
    Next c
xxx:

    Set ReduceRangeR = Range(Cells(r1, c1), Cells(NewRow, c2))
End Function

Private Sub xStrConv(a1, a2)
    If Not TypeName(a1) = "Range" Then
        MsgBox ("セルを選択して下さい")
        Exit Sub
    End If
    
    If a1.Count = 1 Then
        x = StrConv(a1.FormulaLocal, a2)
        GoTo xxx
    End If
    
    RowsCount = a1.Rows.Count
    ColumnsCount = a1.Columns.Count
    r1 = a1.Row
    c1 = a1.Column
    r2 = RowsCount + r1 - 1
    c2 = ColumnsCount + c1 - 1
    
    x = Range(Cells(r1, c1), Cells(r2, c2)).FormulaLocal
    
    For r = 1 To RowsCount
        For c = 1 To ColumnsCount
            x(r, c) = StrConv(x(r, c), a2)
        Next c
    Next r

xxx:
    a1.Value = x
End Sub

2010年6月14日月曜日

【Excel】無駄な選択範囲を縮める②【VBA】

　昨日は、引数Rangeをとり、下方の空白行を除いたRangeを返す関数を作ったので、今回は、右方の空白行を除いたRangeを返す関数を作ってみました。

Sub HowToUse()
    ReduceRangeC(Selection).Select
End Sub

Private Function ReduceRangeC(a1 As Range) As Range
    r1 = a1.Row
    c1 = a1.Column
    r2 = a1.Rows.Count + r1 - 1
    c2 = a1.Columns.Count + c1 - 1
    
    Set f = Application.WorksheetFunction
    
    NewColumn = c1
    For c = c2 To c1 Step -1
        If f.CountA(Range(Cells(r1, c), Cells(r2, c))) > 0 Then
            NewColumn = c
            GoTo xxx
        End If
    Next c
xxx:
    
    Set ReduceRangeC = Range(Cells(r1, c1), Cells(r2, NewColumn))
End Function

2010年6月13日日曜日

【Excel】無駄な選択範囲を縮める【VBA】

　"Range("A65536").End(xlUp).Row"で、データが入力されている最終行を取得するのはExcelVBAの定石なので、これを汎用性のある関数にしてみました。

Sub HowToUse()
    ReduceRangeR(Selection).Select
End Sub

Private Function ReduceRangeR(a1 As Range) As Range
    r1 = a1.Row
    c1 = a1.Column
    r2 = a1.Rows.Count + r1 - 1
    c2 = a1.Columns.Count + c1 - 1
    
    NewRow = r1
    For c = c1 To c2
        If Len(Cells(r2, c)) > 0 Then
            NewRow = r2
            GoTo xxx
        End If
        r = Cells(r2, c).End(xlUp).Row
        If r > NewRow Then
            NewRow = r
        End If
    Next c
xxx:

    Set ReduceRangeR = Range(Cells(r1, c1), Cells(NewRow, c2))
End Function

　引数にRangeをとって、下方の空白行を除いたRangeを返します。

　実行前

　実行後

【Excel】半角と全角の変換マクロ⑦【VBA】

　疲れたので、きちんとした速度測定は次回(笑)。でも多分更に高速化されているはず。

Sub 全角に変換する()
    If Not TypeName(Selection) = "Range" Then
        MsgBox ("セルを選択して下さい")
        Exit Sub
    End If
    
    t = Timer
    
    Call ExStrConv(Selection, vbWide)
    
    Application.StatusBar = _
        ("全角に変換しました。 " & Timer - t & " 秒")
End Sub

Sub 半角に変換する()
    If Not TypeName(Selection) = "Range" Then
        MsgBox ("セルを選択して下さい")
        Exit Sub
    End If
    
    t = Timer
    
    Call ExStrConv(Selection, vbNarrow)
    
    Application.StatusBar = _
        ("半角に変換しました。 " & Timer - t & " 秒")
End Sub

Private Sub ExStrConv(a1 As Range, a2)
    If a1.Count = 1 Then
        '選択セルが一つだけの場合の処理
        'x As String
        
        x = StrConv(a1.FormulaLocal, a2)
    
    Else
        '選択セルが二つ以上の場合の処理
        'x As Variant()
        
        With a1
            r1 = .Row
            c1 = .Column
            r2 = .Rows.Count + r1 - 1
            c2 = .Columns.Count + c1 - 1
            RowsCount = .Rows.Count
            ColumnsCount = .Columns.Count
        End With
        
        x = Range(Cells(r1, c1), _
                  Cells(r2, c2)).FormulaLocal
        
        For r = 1 To RowsCount
            For c = 1 To ColumnsCount
                x(r, c) = StrConv(x(r, c), a2)
            Next c
        Next r
    
    End If
    
    a1.Value = x
End Sub

【Excel】半角と全角の変換マクロ⑥【VBA】

　".Rows.Count"と".Columns.Count"を何度も呼ばずに、あらかじめ一度だけ変数に入れておけば少しは速くなる？と思って試してみました。

Option Base 1

Sub 全角に変換する()
    Call xStrConv(Selection, vbWide)
End Sub

Sub 半角に変換する()
    Call xStrConv(Selection, vbNarrow)
End Sub

Private Sub xStrConv(a1, a2)
    Max = 655360 '10列分のセル数
    
    If Not TypeName(a1) = "Range" Then
        MsgBox ("セルを選択して下さい")
        Exit Sub
    ElseIf a1.Count > Max Then
        MsgBox ("処理出来るデータの数は" & Max & "までです")
        Exit Sub
    End If
    
    rEnd = a1.Rows.Count
    cEnd = a1.Columns.Count
    
    Dim x: ReDim x(rEnd, cEnd)
    For r = 1 To rEnd
        For c = 1 To cEnd
            x(r, c) = StrConv(a1(r, c).FormulaLocal, a2)
        Next c
    Next r
    a1.Value = x
End Sub

　何もデータの入っていないシートのセルを全選択して計測。

書き換え前
全角：124.6094秒
半角：124.0938秒

書き換え後
全角：121.5秒
半角：121.3594秒

　うわ、微妙ｗｗｗ。

【Excel】半角と全角の変換マクロ⑤【VBA】

　一晩寝て見直してみたら、昨日のコードよりも一昨日のコードのほうがシンプルでいいかな、と言う気がしてきたので、コードの基本的な骨格は一昨日のものを流用しつつ、配列を使って高速化してみました。

Option Base 1

Sub 全角に変換する()
    Call xStrConv(Selection, vbWide)
End Sub

Sub 半角に変換する()
    Call xStrConv(Selection, vbNarrow)
End Sub

Private Sub xStrConv(a1, a2)
    Max = 655360 '10列分のセル数
    
    If Not TypeName(a1) = "Range" Then
        MsgBox ("セルを選択して下さい")
        Exit Sub
    ElseIf a1.Count > Max Then
        MsgBox ("処理出来るデータの数は" & Max & "までです")
        Exit Sub
    End If
    
    Dim x: ReDim x(a1.Rows.Count, a1.Columns.Count)
    For r = 1 To a1.Rows.Count
        For c = 1 To a1.Columns.Count
            x(r, c) = StrConv(a1(r, c).FormulaLocal, a2)
        Next c
    Next r
    a1.Value = x
End Sub

　普段使いには一昨日のコード、大量のデータを変換したければ今回のコードを使えば良さそうです。

2010年6月12日土曜日

【Excel】半角と全角の変換マクロ④【VBA】

　文字列変換のマクロを更に改良。
　2010年6月10日木曜日のコードでも、とりあえずは完成だと思うのだけれど、せっかく名称を"xStrConv"としたのならば、"StrConv"関数と同じような呼び方が出来た方が分かりやすいです。つまり…、

    Selection.Value = xStrConv(Selection, vbWide)

みたいな呼び方が出来ればスマートかと。
　もちろん、"StrConv"関数を

    Selection.Value = StrConv(Selection, vbWide)

みたいに書くと「型が一致しません」と言うエラーが出ます。
　以下がコード。

Option Base 1

Sub 全角に変換する()
    Selection.Value = xStrConv(Selection, vbWide)
End Sub

Sub 半角に変換する()
    Selection.Value = xStrConv(Selection, vbNarrow)
End Sub

Private Function xStrConv(a1, a2)
    Dim x: ReDim x(a1.Rows.Count, a1.Columns.Count)
    For r = 1 To a1.Rows.Count
        For c = 1 To a1.Columns.Count
            x(r, c) = StrConv(a1(r, c).FormulaLocal, a2)
        Next c
    Next r
    xStrConv = x
End Function

　データを配列に格納して処理する仕様へ変更したので処理が高速です。
　処理が高速なので、たくさんのセルを選択したときにエラーを出すコードを思い切って削除しました。
　ちなみに僕の環境では、セルを全選択して実行しようとすると、「メモリが不足しています」と言うエラーが出ます。
　データを読み込む際に、値で読み込むのではなく、"FormulaLocal"を使う事により、結果として数式の入力されたセルをスキップしているかのように動作します。
　ここで、"Formula"ではなく"FormulaLocal"を使っているのがミソで、最初は"JIS"関数が"=ＤＢＣＳ(A1)"のようなワケの分からない文字列に化けて、ハマッてしまいました。
　救ってくれたのがこのサイト。多謝！

2010年6月10日木曜日

【Excel】半角と全角の変換マクロ③【VBA】

　文字列変換のマクロに、セル以外のオブジェクトが選択された場合と、選択セルが多すぎる場合にメッセージを表示するコードを付け加えました。
　また、引数をStrConv関数に合わせてみました。

Sub 全角に変換する()
    Call xStrConv(Selection, vbWide)
End Sub

Sub 半角に変換する()
    Call xStrConv(Selection, vbNarrow)
End Sub

Private Sub xStrConv(a1, a2)
    Max = 5000
    Set f = Application.WorksheetFunction
    
    If Not TypeName(a1) = "Range" Then
        MsgBox ("セルを選択して下さい")
        Exit Sub
    ElseIf f.CountA(a1) > Max Then
        MsgBox ("処理出来るデータの数は" & Max & "までです")
        Exit Sub
    End If
    
    For Each c In a1
        If Len(c) > 0 Then
            If Not c.HasFormula Then
                c.Value = StrConv(c, a2)
            End If
        End If
    Next
End Sub

2010年6月9日水曜日

【Excel】半角と全角の変換マクロ②【VBA】

　昨日に引き続きセルに入力された文字列を変換するマクロ。

　タイムの測定は記事がごちゃごちゃして見難くなる(笑)ので割愛。

Sub 全角に変換する()
    Call Sample(vbWide)
End Sub

Sub 半角に変換する()
    Call Sample(vbNarrow)
End Sub

Sub Sample(a)
    For Each s In Selection
        If Not Len(s) = 0 Then
            If Not s.HasFormula Then
                s.Value = StrConv(s, a)
            End If
        End If
    Next
End Sub

　列が全選択される事を想定して空白セルをスキップするコードを追加。

　ついでに、セルに数式が入力されている場合もスキップする仕様に変更。

　配列に格納するやり方は速度が魅力だけど、コードのメンテナンスのやりやすさ等、トータルに考えて、この辺りが落としどころかなぁ。

2010年6月8日火曜日

【Excel】半角と全角の変換マクロ【VBA】

　ワードには文字列を半角から全角、全角から半角に変換する機能が標準で付いていますが、エクセルには付いていません。

　ワークシート関数を使えば良いといえば良いのですが、そのためだけに使用するセルが増えて表がごちゃごちゃするのも嫌だと言う事でしょう。半角と全角を変換するマクロは割とあちこちで目にします。

Sub xxx()
    Dim t: t = Timer
    For Each c In [a1:j1000]
        c.Value = c.Address
    Next
    [a1:j1000].Select
    Debug.Print (Timer - t & "秒")
    '1.351563秒
End Sub

Sub callSample01Wide()
    Dim t: t = Timer
    Call Sample01(vbWide)
    Debug.Print (Timer - t & "秒")
    '約16秒
End Sub

Sub callSample01Narrow()
    Dim t: t = Timer
    Call Sample01(vbNarrow)
    Debug.Print (Timer - t & "秒")
    '約3秒
End Sub

Sub callSample02Wide()
    Dim t: t = Timer
    Call Sample02(vbWide)
    Debug.Print (Timer - t & "秒")
    '約2秒
End Sub

Sub callSample02Narrow()
    Dim t: t = Timer
    Call Sample02(vbNarrow)
    Debug.Print (Timer - t & "秒")
    '約0.9秒
End Sub

Sub Sample01(a)
    For Each c In Selection
        c.Value = StrConv(c, a)
    Next
End Sub

Sub Sample02(a)
    x = Selection
    For r = 1 To Selection.Rows.Count
        For c = 1 To Selection.Columns.Count
            x(r, c) = StrConv(x(r, c), a)
        Next c
    Next r
    Selection = x
End Sub

　いろいろ書いていますが、下の方のSample01とSample02がコードの本体です。

　引数として、vbNarrowやvbWideを取れるようにして、汎用性を持たせました。

　Sample01は率直ですがやや処理に時間がかかります。

　Sample02は高速に動作しますが、セル範囲が一つだけのケースでエラーが発生します。

【Excel】数式の入力されたセルに色を付ける

名前
    isFormula
参照範囲
    =GET.CELL(48,!A1)

条件付き書式
    =isFormula

　48は数式、A1の前についている!は、アクティブシートを意味するとの事。
　つまりこの式はセルが数式の場合にTrueを返します。

　"=GET.CELL(48,!A1)"でググれば情報はたくさん出てきます。

2010年6月7日月曜日

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

　2010年5月25日火曜日の記事で書いたコードを簡略化。

Option Explicit

Sub Sumple()
    Dim t: t = Timer

    '計測対象のコード

    Debug.Print (Timer - t & " 秒")
End Sub

2010年6月6日日曜日

【Excel】Len関数(意味のない比較だったかもｗ)【VBA】

　100未満の数の抽出するにあたり、値そのものを見るのと、Len関数で桁数を見るのと、どっちが速いかと思って試してみたのですが…、

Public StartTime As Double
Public EndTime As Double

Sub TimerStart()
    StartTime = Timer
End Sub

Sub TimerStop()
    EndTime = Timer
    Debug.Print (EndTime - StartTime & " 秒")
End Sub

Sub xxx()
    Call TimerStart         '---- 測定開始
    For Each c In [a1:a50000]
        c.Value = Round(Rnd() * 1000)
    Next
    [a1:a50000].Copy [b1:b50000]
    Call TimerStop          '---- 約3.42秒
End Sub

Sub SampleA()
    Call TimerStart         '---- 測定開始
    For Each c In [a1:a50000]
        If c.Value < 100 Then
            c.Value = "100以下です"
        End If
    Next
    Call TimerStop          '---- 約1.33秒(注)
End Sub

Sub SampleB()
    Call TimerStart         '---- 測定開始
    For Each c In [b1:b50000]
        If Len(c.Value) < 3 Then
            c.Value = "100以下です"
        End If
    Next
    Call TimerStop          '---- 約1.4秒(注)
End Sub

'-- (注)処理速度は生成された乱数に応じて変わりうる

　…これはお題が悪かったかなぁ。(´・ω・｀)
　一応、値そのものをみるSampleAの方が僅差で速いようです。
　どちらも整数値を見て条件分岐してる訳だから、差が出ないのは当然か。

　むしろ、50,000回呼び出されているにもかかわらず、処理速度を落とさないLen関数がすごいと言えるかも。

　次回は文字列の処理に対して、
「If s = "" Then」と
「If Len(s) = 0 Then」
の違いを比較してみようかな。

EXILIM and Cyber-Shot

　最近SonyのCyber-Shotを買ったので、CASIOの昔のEXILIMと並べてみました。

　さすがに性能には大きな開きがありますが、EXILIMは動作が機敏なので、道具としての使い勝手はいまだに上々です。

　どう言う訳か僕は、新しい道具を手に入れると、古い道具を引っ張り出してきて使いたくなるようです。

2010年6月5日土曜日

【Excel】描画オブジェクトの全削除（速度測定）【VBA】

　昨日、ネットで拝借したコードの速度測定をしてみます。

Public StartTime As Double
Public EndTime As Double

Sub TimerStart()
    StartTime = Timer
End Sub

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

Sub Add5000Lines()
    Call TimerStart         '---- 測定開始
    For i = 1 To 5000
        ActiveSheet.Shapes.AddLine(10, i, 100, i).Select
    Next
    Call TimerStop          '---- 約0.38秒
End Sub

Sub DrawingObjectsDelete01()
    Call TimerStart         '---- 測定開始
    ActiveSheet.DrawingObjects.Delete
    Call TimerStop          '---- 約0.12秒!!!
End Sub

Sub DrawingObjectsDelete02()
    Call TimerStart         '---- 測定開始
    Set dr = ActiveSheet.DrawingObjects
    For Each d In dr
        d.Delete
    Next
    Set dr = Nothing
    Call TimerStop          '---- 約33秒
End Sub

　まずは、Add5000Lines()でラインオブジェクトを5000本引きます。
　その後に描画オブジェクトを削除するコード２種類について処理速度を比較しています。
　DrawingObjectsDelete01()は高速ですが、非表示のオブジェクトを削除出来ません。
　DrawingObjectsDelete02()は低速ですが、非表示のオブジェクトも削除してくれます。
　つまり、昨日のコードはこの二つのコードの二段構えになっています。
　素晴らしいです。

2010年6月4日金曜日

【Excel】描画オブジェクトの全削除【VBA】

Sub AllDrawingObjectsDelete()
    Set dr = ActiveSheet.DrawingObjects
    
    '-- Visible = Trueの描画オブジェクトを全削除
    dr.Delete
    
    '-- Visible = Falseの描画オブジェクトを全削除
    For Each d In dr
        d.Delete
    Next

    Set dr = Nothing
End Sub

　ここを参考にさせていただきました。

　う～ん、素晴らしいです。

2010年6月1日火曜日

【Excel】変数の型を表示させる【VBA】

　前回と同じコードをサンプルに使うのも何なので、まずは2010年5月30日日曜日のフォルダ一覧を表示させるコードをファイル一覧を表示させるコードへ変更。

Sub MakeFileList()
    Set fs = CreateObject("Scripting.FileSystemObject").GetFolder("C:\").Files
    Dim x: ReDim x(fs.Count, 1)
    For Each f In fs
        x(i, 0) = f.Name
        i = i + 1
    Next
    Range("A1:A" & fs.Count) = x
End Sub

　一行目末尾を"SubFolders"から"Files"に変更するだけでOK。

　変数の型を知りたい場合は以下のようにデバッグ用のコードを追加する。

Sub MakeFileList()
    Set fs = CreateObject("Scripting.FileSystemObject").GetFolder("C:\").Files
    Dim x: ReDim x(fs.Count, 1)
    For Each f In fs
        x(i, 0) = f.Name
        i = i + 1
    
    tn = TypeName(f)        '<-- debug
    
    Next
    Range("A1:A" & fs.Count) = x
    
    MsgBox ("i  as " & TypeName(i) & vbCrLf & _
            "x  as " & TypeName(x) & vbCrLf & _
            "f  as " & TypeName(f) & vbCrLf & _
            "fs as " & TypeName(fs) & vbCrLf & _
            "---------------------" & vbCrLf & _
            "f  as " & tn & vbCrLf & _
            "tn as " & TypeName(tn) _
            )               '<-- debug
    
End Sub

　実行すると以下のようなメッセージが出ます。

　ループ文の外で型を調べているので、普通に書くと変数"f"の型が"Empty"と表示されてしまいます。

　なので、デバッグ用にあらたに変数"tn"を用意し、ループ文の中で"f"の型を調べて、"tn"に代入した上で表示させています。

　ついでに"tn"の型も調べてみたら、"String"でした。

　この事からTypeName()関数は、変数の型を"文字列"で返す事がわかります。

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日土曜日

月配列Ｒ＿２０１００５０６

　ゴールデンウィーク中にぐちゃぐちゃにいじって、ゴールデンウィークが明けたら割と普通に戻りました。

　普通と言っても、何と比べての普通だよ！って話ですけどｗ。

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

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秒

で固定値の勝ち。これは当たり前かｗ。

　つまり実際に使用する際は、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の勝ち。て言うかどちらも一瞬ですねｗ。

　もしかしたら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日水曜日

全シートでセルの選択範囲を同期②（Ｅｘｃｅｌ　ＶＢＡ）

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

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日日曜日

全シートでセルの選択範囲を同期（Ｅｘｃｅｌ　ＶＢＡ）

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

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

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

　ファイル名を＂ＳｅｌｅｃｔＳｙｎｃ．ｘｌｓ＂とでもして、読み取り専用で持っておき、データを比較するときに使い捨てれば良い。

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

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

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

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

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

　最近、僕もこのカスタマイズに手を出しました。

（最近と言っても２月１４日だったようですｗ）

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

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

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

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

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

2010年5月1日土曜日

月配列Ｒ＿２０１００５０１（やりすぎ？ｗ）

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

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

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

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

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

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

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

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

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

2010年4月25日日曜日

タイプウェル「Ｃ」＠英単語

　指の運動＋ちょっぴり英語のお勉強、って事でタイプウェル英単語にも取り組み始めました。

　根気よく練習していれば、アラフォーでも微速ながら成長できるようです。

　基本的に運指の最適化とかは、極力やらない方針なのですが、英単語を打つ際の”ｃｅ”のみはｃ＝人差し指、ｅ＝中指で、最適化した方が良いと感じました。

2010年4月17日土曜日

月配列Ｒ＿２０１００４１７－２

　またしても配列替えｗ。

　時間に余裕が出来るとついやってしまいます。

2010年3月31日水曜日

月配列Ｒ＿２０１００３３０

シフトなし

こＷとけひ｜れるいおの

してＤかは｜っんＫＬ

すそせきさ｜くう

Ｄシフト

＿＿＿＿＿｜ぬわあにえ

＿＿Ｄろ＿｜やつまち

＿＿＿＿＿｜みり

Ｋシフト

＿ねゃほゆ｜ぁぃぅぇぉ

なたょもら｜＿むＫ＿

ふめゅよへ｜＿＿

Ｌシフト

ごだどげび｜＿ぢべ＿＿

じでをがば｜づぼぶＬ

ずぞぜぎざ｜ぐヴ

Ｗシフト

＿Ｗ＿＿＿｜＿＿ぷぱ＿

＿＿＿＿＿｜＿ぽぴぺ

＿＿＿＿＿｜＿＿

　久々に大きく変更。

　でも、意外とすんなり慣れてしまった。

　配列変えに耐性がついたのかなｗ。

2010年3月28日日曜日

Ｌｅｔ’ｓ　Ｎｏｔｅ　ＣＦ－Ｓ９Ｊ　購入

ｅＭｏｂｉｌｅも契約した。

2010年3月7日日曜日

複数の入力法は共存できるのか

・私家版カナ配列（中指シフト）

・私家版行段系配列

・Ｑｗｅｒｔｙローマ字入力

　以上３つの日本語入力法を、混乱することなく使い分けられるかテスト中。

　僕のこの努力は果たして世のため人のために役に立つのだろうかｗ

2010年2月20日土曜日

Ｌｉｂｅｒｔｏｕｃｈのキー加重カスタマイズ　その６

　「Ａｌｔ」キーを「変換」キーの位置へ移動。

2010年2月14日日曜日

Ｌｉｂｅｒｔｏｕｃｈのキー加重カスタマイズ　その５

　もしかして数字段はずらさない方が良い？

　~~ハイフンを薬指で打てそうだし、結構良さそうに見えます。~~

　何事もチャレンジです。

【追記】

　使い始めて５分もしないうちに「これはあかん」と思いました。

　「全部まとめて右にずらす」のがミソなのであって、「部分的に右にずらす」のは、使い手の負担が大きすぎます。＿|￣|○

タイプウェル「ちょっと前進」＠月配列Ｒ

　(｀・ω・´)

　がんばればもう少し行けそうな気もするけど、こればかりやってるのも何だし、あまり深追いはするまい。

Ｌｉｂｅｒｔｏｕｃｈのキー加重カスタマイズ　その４

　右手一列ずらしにすると、「ひらがな」キーが右手親指で押下するのに絶好の位置に来ます。

　なので、「ひらがな」キーと「Ａｌｔ」キーを入れ替える事にしました。

　マウスを使わずに何でもかんでもキーボードで操作しようとする僕にとって、「右Ａｌｔ」が押下しやすくなるのはかなりのメリットです。

Ｌｉｂｅｒｔｏｕｃｈのキー加重カスタマイズ　その３

　調子に乗って、右手担当のキーを右に一個ずらしてみました。

　ラバードームもキートップも上図のように入れ替え。

　この配列カスタマイズは、変則配列使いの間では割とメジャーであるようです。

2010年1月24日日曜日

Ｌｉｂｅｒｔｏｕｃｈのキー加重カスタマイズ　その２

　今朝起きてすぐに、昨日書いた設計図通りにカスタマイズしてみた所、さほど違和感も無く、好感触でした。

　で、実際にあれこれ替えてみて、今はこんな感じになりました。

　これ、面白いです。

Ｌｉｂｅｒｔｏｕｃｈ

　去年の冬のボーナスで富士通のＬｉｂｅｒｔｏｕｃｈを購入しました。

　このキーボードは、押下圧の異なるラバードームが軽重それぞれ１５個ずつ付属しており、キーの重さを自分好みに調整することが出来ます。

　別に全て等加重でもいいかな？と思って特に弄らずにいたのですが、久々に集中的に練習してみたら、意外と右の小指が疲れました。

　なので、明日はカスタマイズをやってみたいと思います。

　とりあえず、どのキーをどの重さにするかの設計図(笑)を描いてみました。

　こう言うのを描いているときが一番楽しかったりします。

2010年1月23日土曜日

タイプウェル「ＳＪ」＠月配列Ｒ

　(｀・ω・´)

　ここの所、仕事が忙しく、なかなか練習が出来なかったのですが、いきなりひょいっとＳ台が出てくれました。

　上達と言うのは不思議なもので、根を詰めて練習しているときにはちっともスコアが上がらないのに、しばらく練習しないでいると急に上手くなったりします。

読み間違え

　タイプウェルをやっていて気づいたのですが、お題を読み間違えた結果としてのタイプミス、と言うのが少なからずあるようです。

2010年1月17日日曜日

タイプウェル「Ｂ」＠Ｑｗｅｒｔｙローマ字入力

　2009年11月8日日曜日の記事で、「ローマ字入力を復活させる事で、往年の指の回転を取り戻そう。」などと書いておきながら、がんばって打ってもＢとはｗｗｗ。

　でもまぁだんだんスムーズに打てるようになってきたので、そろそろミス制限設定を０にしようと思います。

月配列Ｒ＿２０１００１１２

　まぁまぁ安定しているのでメモ的にアップ。

　前回（２００９１２３１）との違いは、「ゃゅょ」の配置。これをシフト面に縦一列に並べてみました。

　似た系列のカナはなるべく似た運指にまとめると言う試みなのですが、果たして吉と出るかどうか。

　あとは、左手小指の使用率を下げるべく、「ら」と「ふ」の入れ替え。

　「た」と「ょ」がシフト面なのは以前と変わらず。

2010年1月16日土曜日

タイプウェル「Ａ」＠月配列Ｒ

　(｀・ω・´)

　配置をいじくり過ぎて、なかなか速度が上がらないのですが、やっとカタカナ語がＡになりました。

登録: 投稿 (Atom)

2010年12月25日土曜日

2010年11月27日土曜日

2010年11月18日木曜日

2010年11月16日火曜日

2010年11月3日水曜日

2010年10月27日水曜日

2010年10月24日日曜日

2010年10月23日土曜日

2010年10月17日日曜日

2010年10月11日月曜日

2010年9月29日水曜日

2010年9月23日木曜日

2010年9月20日月曜日

2010年9月18日土曜日

2010年9月3日金曜日

2010年7月10日土曜日

2010年6月27日日曜日

2010年6月20日日曜日

2010年6月19日土曜日

2010年6月16日水曜日

2010年6月15日火曜日

2010年6月14日月曜日

2010年6月13日日曜日

2010年6月12日土曜日

2010年6月10日木曜日

2010年6月9日水曜日

2010年6月8日火曜日

2010年6月7日月曜日

2010年6月6日日曜日

2010年6月5日土曜日

2010年6月4日金曜日

2010年6月1日火曜日

2010年5月30日日曜日

2010年5月29日土曜日

2010年5月26日水曜日

2010年5月25日火曜日

2010年5月24日月曜日

2010年5月23日日曜日

2010年5月19日水曜日

2010年5月16日日曜日

2010年5月1日土曜日

2010年4月25日日曜日

2010年4月17日土曜日

2010年3月31日水曜日

2010年3月28日日曜日

2010年3月7日日曜日

2010年2月20日土曜日

2010年2月14日日曜日

2010年1月24日日曜日

2010年1月23日土曜日

2010年1月17日日曜日

2010年1月16日土曜日

Twitter

ブログ アーカイブ

ラベル

ブログアーカイブ