StrRevers関数

以前の記事『 回文判定マクロ 』で
文字列を反対から並べるという操作を
For文を使ってやりました。

その時は探しもしなかったのですが、
それ用の関数がありました。

それがStrRevers関数です。
使い方は例えば、

Debug.Print StrReverse("文字列")

を実行するとイミディエイトに
「列字文」と出力されます。

上の記事のコードにStrReverse関数を使うなら
上の記事のコードのこの部分を

'反対から並べ替える
    For i = Len(Str) To 1 Step -1
        Str2 = Str2 + Mid(Str, i, 1)
    Next i

次のコードで置き換えてください。

    '反対から並べ替える
    Str2 = StrReverse(Str)

一行でできますね。

メソッド、プロシージャ、関数の呼び出しと引数指定

メソッド、プロシージャ、関数を呼び出すときの引数について、
括弧が要るのか、要らないのか？
複数の引数はどのように指定するか？
名前付引数はどう使うのか？
など整理したいと思います。
以下の順にみていきます。

1.メソッドの呼び出し
2.Subプロシージャの呼び出し
    2-a.Callステートメントを使用
    2-b.Callステートメントを不使用
3.関数(Functionプロシージャ)の呼び出し
    3-a.戻り値を使う
    3-b.戻り値を使わない

1.メソッドの呼び出し

・括弧は不可
・複数の引数を持つ場合、コンマで構文順に続ける
・名前付引数を使用して呼び出す場合は、
「引数名 := 値」の形でそれぞれの引数を指定する。
引数の順序は任意

例としてOnTimeメソッドを使います。
OnTimeメソッドの構文は次の通り。

expression.OnTime(EarliestTime, Procedure, LatestTime, Schedule)

LatestTime、Scheduleは省略可能なので省略します。
例：

Application.OnTime Now() + TimeValue("00:00:10"), "マクロ名"

Application.OnTime _
    EarliestTime:=Now() + TimeValue("00:00:10"), _
    Procedure:="マクロ名"

2.Subプロシージャの呼び出し

2-a.Callステートメントを使用

・括弧は必要
・複数の引数を持つ場合、コンマで構文順に続ける
・名前付引数を使用して呼び出す場合は、
「引数名 := 値」の形でそれぞれの引数を指定する。
引数の順序は任意

例：

Call プロシージャ名(値)
Call プロシージャ名(値1, 値2, 値3)
Call プロシージャ名(引数名1:=値1, 引数2:=値2, 引数3:=値3)

2-b.Callステートメントを不使用

・括弧は不要
・複数の引数を持つ場合、コンマで構文順に続ける
・名前付引数を使用して呼び出す場合は、
「引数名 := 値」の形でそれぞれの各引数を指定する。
引数の順序は任意

例：

プロシージャ名 値
プロシージャ名 値1, 値2, 値3
プロシージャ名 引数名1:=値1, 引数2:=値2, 引数3:=値3

3.関数(Functionプロシージャ)の呼び出し

3-a.戻り値を使う

・括弧は必要
・複数の引数を持つ場合、コンマで構文順に続ける
・名前付引数を使用して呼び出す場合は、
「引数名 := 値」の形でそれぞれの引数を指定する。
引数の順序は任意

例としてMsgBoxを使います。
MsgBoxの構文([ ]内は省略可能)

MsgBox(prompt[, buttons] [, title] [, helpfile, context])

例：

Dim flag As Integer
flag = MsgBox("Yes or No？", vbYesNo, "タイトル")

Dim flag As Integer
flag = MsgBox(prompt:="Yes or No？", Buttons:=vbYesNo, Title:="タイトル")

3-b.戻り値を使わない

・括弧は不要
・複数の引数を持つ場合、コンマで構文順に続ける
・名前付引数を使用して呼び出す場合は、
「引数名 := 値」の形でそれぞれの引数を指定する。
引数の順序は任意

例：

MsgBox "実行します"

MsgBox "実行します", , "タイトル"

MsgBox prompt:="実行します", Title:="タイトル"

静的変数/Staticステートメントについて

保持したい値はシートに入れちゃうので
今まで静的変数を使わなかったのですが、
ここいらで使えるところは使えるようになりたいですね。

まずは、静的変数とは？
というところからです。

静的変数とは、
プロシージャレベルで使用し
プログラムが実行されている間だけ値が保持される変数。
モジュールがリセットされるか再実行されるまで、保持される。

と、このようにVBAヘルプの説明にあります。

静的変数を宣言するにはStaticステートメントを使います。
例えば次のようにする。

Static a As Integer
Static str As String
Static a(10) As Integer

最後の例のように配列も使えます。
文字だけでは実感として理解できないので試行します。

Sub macro110522a()
'静的変数使用例

    Static a As Integer
   
    a = a + 1
    Debug.Print a
   
End Sub

上のコードを一回実行すると a = 1
2回目を実行すると a = 2
3回目を実行すると a = 3
…
のように、
プロシージャが終了しても静的変数 a の値は保持されます。

ウォッチウィンドウに静的変数aをいれて見ていたのですが
プロシージャが実行されている間だけ値が表示されていました。

プロシージャレベルというところがミソですね。
静的変数を宣言したプロシージャ以外では使えないということです。

昨日の今日ですが、
静的変数を使用して
解除可能なOnTimeメソッドの使用方法を作ってみます。

前回は実行と解除を別の関数とプロシージャでしましたが、
今回はこれらを１つの関数でできるようにします。

Sub OnTimeFunc2(d As Date, Optional mName As String)
'キャンセル可能なOnTime使い方
'd = 実行したい日時
'mName = マクロ名
'直前１つを解除する場合、d = 0

    Static d2 As Date
    Static mName2 As String
   
    If d = 0 Then
        '解 除
        On Error Resume Next
            Application.OnTime d2, mName2, , False
        On Error GoTo 0
    Else
        'OnTime実行
         Application.OnTime d, mName
    End If
   
    d2 = d
    mName2 = mName
   
End Sub

Sub macro110522b()
'OnTimeFunc2使用例
'実行
    Debug.Print Now() & "　macro110522b実行"
   
    '繰り返し実行 したい処理
    '…
   
    '次回実行を設定
    Call OnTimeFunc2(Now() + TimeValue("00:00:10"), "macro110522b")
   
End Sub

Sub macro110522c()
'OnTimeFunc2使用例
'解除
   
    Call OnTimeFunc2(0)
   
End Sub

静的変数は値が保持される代わりに、
最初に割り当てられたメモリが
プロシージャの終了後も開放されないので
必要以外は使わないほうがよいようです。

OnTimeでの設定を解除する

繰り返し実行するのには便利なOnTimeメソッドですが、
いろいろと不明な部分もあります。

OnTimeで繰り返しを始めたかを忘れてしまって
2回目の繰り返しを始めてしまうことがあります。
結果パラレルワールドです。

なぜそのようなことになってしまうかと考えてみると
OnTimeで設定したものが調べられないからです。
調べられないから解除もできない。

実はOnTimeメソッドは解除もできます。
前にVBAヘルプのOnTimeメソッドを読んだときには
気が付きませんでした。

しかしこの解除の方法…
なかなか使えないシロモノです。

OnTimeで10秒後に設定するときはこうです。

Application.OnTime _
    Now() + TimeValue("00:00:10"), _
    "マクロ名"

上のコードを実行する時点で
Now() + TimeValue("00:00:10") = "2011/05/21 9:32:20"とする。

このコードで設定したものを解除するには
同じ日時、同じマクロ名で
最後に「, , False」を付加します。
詳細はVBAヘルプにあります。

Application.OnTime _
    CDate("2011/05/21 9:32:20"), _
    "マクロ名", , False

これで解除できます。

次のコードでは解除できずにエラーになります。

Application.OnTime _
    Now() + TimeValue("00:00:10"), _
    "マクロ名", , False

理由はNow関数はその時々によって値が変化していくので
同じ「Now() + TimeValue("00:00:10")」でも
値が違ってきます。

以上の理由でOnTimeの設定をキャンセルするには
どこかに設定した日時を残しておかなければいけません。

なにかいい方法はないかと調べてみました。
マイクロソフトサポートに下のページがありました。
XL2000: Canceling OnTime Macro When Time Argument Is Volatile

このページに書かれている方法は要するに、
開始した時刻から59秒間だけ
15秒間隔でTestMacroプロシージャを実行するということです。

ん～使えない、
やはりシートに日時を残すしかないのか？
まあこの簡便さがVBAがいいなと思うところでもあります。

ではまず
それ用の"OnTime"シートを作成します。
OnTimeメソッドを使用したときには、
ここに引数の値を残します。

もし解除したいときは、
"OnTime"シートの値を使います。
以上

コードはこちら

Sub OnTimeFunc(d As Date, mName As String)
'解除可能なOnTime使い方
   
    'OnTimeシートがなければ挿入
    Dim sh As Object
    For Each sh In Worksheets
        If sh.Name = "OnTime" Then
            GoTo Step1
        End If
    Next sh
   
    Sheets.Add.Name = "OnTime"
    Cells(1, 1) = "OnTime設定"
    Cells(2, 1) = "日時"
    Cells(2, 2) = "マクロ名"
   
Step1:
    'OnTimeの設定を記録
    With Sheets("OnTime")
        .Rows(12).Delete xlShiftUp
        .Rows(3).Insert
        .Cells(3, 1) = d
        .Cells(3, 1).NumberFormat = _
            "yyyy/mm/dd hh:mm:ss"
        .Cells(3, 2) = mName
    End With
   
    'OnTime実行
    Application.OnTime d, mName
   
End Sub

Sub macro110521a()
'OnTime2使用例
    Debug.Print "macro110521a実行"
   
    '繰り返し実行したい処理を記述
    '…

    '次回の実行を設定
    Call OnTimeFunc( _
        Now() + TimeValue("00:00:10"), _
        "macro110521a" _
        )
   
End Sub

Sub macro110521b()
'OnTime2で記録しておいたものを使って
'直前のOnTimeを解除する

    Debug.Print "macro110521b実行"
   
    Dim d As Date
    Dim mName As String
    d = Sheets("OnTime").Cells(3, 1)
    mName = Sheets("OnTime").Cells(3, 2)
   
    '解除する
    On Error Resume Next
        Application.OnTime d, mName, , False
    On Error GoTo 0
   
    '解除した行を削除
    Sheets("OnTime").Rows(3).Delete xlShiftUp
   
End Sub

繰り返し実行したい処理は
macro110521aのコメントで指定した箇所に入れてください。
macro110521bは直前のOnTimeをキャンセルします。

"OnTime"シートの様子：

OnTimeメソッドで何を設定したか忘れて
それを実行したくないときは、
Excelを一旦終了しましょう。
または繰り返しているマクロの途中に
Stopかブレークポイントを作ると中断して停止できます。

マクロをショートカットキーに割り当てる

ショートカットキーとは
1つ前の状態に戻るときは Ctrl + z、
コピペは Ctrl + c して Ctrl + v のように
キーボードで特定の操作をできるキーボードのキーです。

頻繁に使うマクロ、
特に選択しているセルの値を変えたり操作したりするタイプのマクロは
ショートカットキーに割り当てると便利です。

まずは手動でショートカットキーを設定します。

[ツール]-[マクロ]-[マクロ]を選択します。

次のダイアログが表示されます。

マクロ名から目的のマクロを選択して
[オプション]ボタンを押します。

マクロオプションのダイアログが表示されます。

ショートカットキーに使うキーと説明を入力します。
これでマクロをショートカットキーで実行できるようになりました。

いままでの操作を自動記録したものを
見やすくしたコードがこちら

Sub macro110515a()
'マクロをショートカットキーに割り当てる

    Application.MacroOptions _
        macro:="macro110424a", _
        Description:="B1セルのVBAコードをHTMLに変換する", _
        ShortcutKey:="h"
       
End Sub

macro = マクロの名前
Description = 説明
ShortcutKey = ショートカットキーに使うキー

上のコードを実行すると
Ctrl + h でmacro110424aが実行されます。

バックアップいろいろ

いろいろなタイミングでのバックアップについて。
ここではバックアップというのは
ファイルの複製をコピーする
ということを指します。

ファイル保存時のバックアップは以前の記事で書きました。
『 ファイル保存時に自動でコピーを作って保存 』

上の記事の補足ですが、
この「保存時」とは手動で保存したときのみです。
記事を書いたときはVBAで保存したときも
イベントが発動すると思っていましたが
違っていました。

VBAで保存したときは、
Workbook_BeforeSaveは発動しません。

他にはどんなタイミングが考えられるかリストアップします。

一定時間ごとにバックアップを保存
ブックを閉じるときにバックアップを保存

いろいろなんて言っておいて
2つしか挙げられないので、
バリエーションで誤魔化します。

1. ○○分ごとにバックアップを作成する
2. ○○分ごとにバックアップを上書き保存する
3. ○○分ごとに本体を保存して、バックアップも作成する
4. ○○分ごとに本体を保存して、バックアップも上書き保存する
5. ブックを閉じるときにバックアップを作成する
6. ブックを閉じるときにバックアップを上書き保存する

以上についてやっていきます。

1. ○○分ごとにバックアップを作成する

○○分ごとといえば
OnTimeです。

コードはこちら

Sub macro110514a()
'1. ○○分ごとにバックアップを作成する

    '本体保存
'    ActiveWorkbook.Save

    Dim wb As String
    '基本の名前をActiveWorkbookの拡張子を除いたものにする
    wb = Replace(ActiveWorkbook.Name, ".xls", "")
    'コ ピーを保存
    ActiveWorkbook.SaveCopyAs _
        ActiveWorkbook.Path & "\" & wb & _
        Format(Now(), "yyyymmdd_hhmmss") & ".xls"
   
    '30分後にこのプロシージャを実行
    '間隔はTimeValue関数内を 変更
    Application.OnTime _
        Now() + TimeValue ("00:30:00"), _
        "macro110514a"

End Sub

このコードは最初の一回を実行しないと
繰り返し実行しないので
ブックを開いたら自分で最初の一回を実行してください。

それも自動でするなら
Workbook_Openイベントを利用します。

ワークブックのオブジェクトモジュールの
イベントの利用方法についても上のリンクの記事を参照してください。

コードはこちら

Private Sub Workbook_Open()

    Dim flag As Integer
    flag = MsgBox("自動バックアップ実行しますか？", _
         vbYesNo, "タイトル")
       
    If flag = 6 Then
        Application.OnTime _
             Now() + TimeValue("00:30:00"), _
             "macro110514a"
    End If
   
End Sub

OnTimeで設定したプロシージャは、
ブックを閉じただけで、Excelが立ち上がっている状態では
設定した時間になると
ブックを閉じていてもブックを開いて実行しようとします。

OnTimeで設定したものをなくしたいときは、
Excel自体を閉じてください。

2. ○○分ごとにバックアップを上書き保存する

これはバックアップを毎回作成していくのではなく、
バックアップのファイルを1つだけ作成して、
次からは上書き保存していきます。

SaveCopyAsメソッドは、
既存の同名ファイルがあっても
エラーや警告になることなく上書き保存されます。

既存の同名ファイルがなければ作成されます。

コードはこちら

Sub macro110514b()
'2. ○○分ごとにバックアップを上書き保存する

    '本体保存
'    ActiveWorkbook.Save
   
    Dim wb As String
    '基本の名前をActiveWorkbookの拡張子を除いたものにする
    wb = Replace(ActiveWorkbook.Name, ".xls", "") & "BackUp"
    'コピーを保存
    ActiveWorkbook.SaveCopyAs _
        ActiveWorkbook.Path & "\" & wb & ".xls"
   
    '30分後にこのプロシージャを実行
    '間隔はTimeValue関数内を変更
    Application.OnTime _
        Now() + TimeValue("00:30:00"), _
        "macro110514b"

End Sub

3. ○○分ごとに本体を保存して、バックアップも作成する

1番のコードに
次の本体を保存するコードを追加するだけです。

'本体保存
ActiveWorkbook.Save

1番のコードにコメントブロックしてありますので
シングルクォーテーションをはずしてください。

4. ○○分ごとに本体を保存して、バックアップも上書き保存する

2番のコードに本体を保存するコードを追加するだけです。
3番と同様にコメントブロックしてあります。

5. ブックを閉じるときにバックアップを作成する

Workbook_BeforeCloseイベントを使用します。

コードはこちら

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'5. ブックを閉じるときにバックアップを 作成する

    Dim wb As String
    '基本の名前を ActiveWorkbookの拡張子を除いたものにする
    wb = Replace(ActiveWorkbook.Name, ".xls", "")
    'コピーを保存
    ActiveWorkbook.SaveCopyAs _
        ActiveWorkbook.Path & " \" & wb & _
        Format(Now(), "yyyymmdd_hhmmss") & ".xls"

End Sub

6. ブックを閉じるときにバックアップを上書き保存する

こちらも
Workbook_BeforeCloseイベントを使用します。

コードはこちら

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'6. ブックを閉じるときにバックアップを 上書き保存する

    Dim wb As String
    '基本の名前 をActiveWorkbookの拡張子を除いたものにする
    wb = Replace(ActiveWorkbook.Name, ".xls", "") & "BackUp"
    'コピーを保存
    ActiveWorkbook.SaveCopyAs _
        ActiveWorkbook.Path & "\" & wb & ".xls"
       
End Sub

同じコードを何回も使ってしまいました。

似たようなことをしていると
同じコードを何回も使用していることが多くなります。

そうなったときは、
独立したプロシージャを作ったほうが
コードの入力は楽です。

Callステートメントで呼び出せば省力できます。

ReplaceメソッドとReplace関数

Replaceメソッドは以前の記事
『 セル内の改行を削除する 』において使用しました。

このReplaceメソッドを使って
セル内の文字列の改行を削除しようとしたら
次のようなエラーが出ることがありました。

これはExcel2003の場合は、
置換後のセル内の文字数が911を超えた場合置換できない現象のようです。
参照： [XL2003] 置換後のセル内の文字数が911を超えた場合置換できない

試しにVBAでこの置換できない現象を確かめてみました。

コードはこちら

Sub macro110508a()
'置換の文字数について
'i=912でエラーになる

    Dim i As Integer
    i = 900
    For i = 912 To 10000
        Range("A1") = WorksheetFunction.Rept("a", i)
        '次がi=912でエラーになる
        Range("A1").Replace "a", "b"
    Next i
   
End Sub

Excel2000においても、
置換後のセル内の文字数が911を超えた場合
置換できませんでした。

さてこういうときはどうすればいいかというと、
題にもあるようにReplace関数を使えば
このような場合も改行を削除できます。

コードはこちら

Sub macro110508b()
'文字列の改行を削除する
'セルA1
    Dim Str As String
   
    Str = Range("A1")
    Str = Replace(Str, Chr(10), "")
    Range("A1") = Str

End Sub

Replaceメソッドを使う場合は
次のようにすると複数のセルを一度に処理できました。

Range("A1:C10").Replace Chr(10), ""

Replace関数はセルの内容を文字列にしてから処理するので
一度に１つのセルしか処理できません。
複数のセルを処理したいときは
For Eachステートメントを使います。

コードはこちら

Sub macro110508c()
'文字列の改行を削除する
'ActiveSheet.UsedRange

    Dim c As Object
    Dim Str As String
    For Each c In ActiveSheet.UsedRange
        Str = c
        Str = Replace(Str, Chr(10), "")
        c = Str
    Next c
   
End Sub

上のコードとても遅いです。

範囲を明確に指定したほうがいいかもしれません。
範囲を指定したいときは

ActiveSheet.UsedRange

の箇所を

ActiveSheet.Range("A1:C10")

などとしてください。

イミディエイトウィンドウ内をクリアする

いろいろとイミディエイトウィンドウに出力していると
見にくくなります。

そのような場合、
手動でイミディエイトウィンドウ内を
すべてを選択して削除していました。

毎回このようなことをしていては
面倒なので
VBAでこれを実行したいと思います。

Debug.Printを使いますが、
文字を出力するのではなく
バックスペースを出力します。

適当に1000回出力します。

コードはこちら

Sub macro110507a()
'イミディエイトウィンドウを
'すべてクリアする

    Dim i As Integer
    For i = 1 To 1000
        'Chr(8)=バックスペース
        Debug.Print Chr(8)
    Next i
   
End Sub

ピタゴラス数

ピタゴラス数とは
2乗するとひとつが他の2つの2乗の和になるような
3つの自然数の組のことです。

式で表すと

a^2 + b^2 = c^2

です。

このピタゴラス数をVBAで求めたいと思います。

プログラム的に求めようと思います。

プログラム的とはどういうことかというと
For文で手当たり次第に条件に合うかどうか
確かめていくということです。

さきほどの式のように変数a、bを作ります。
この2つの変数a、bを使ってFor文を１つ入れ子にします。

入れ子にしたほうのFor文の中で
ピタゴラス数であるかの条件判定(If文)をします。
条件は次のようにしました。

Int(Sqr(a^2 + b^2)) = Sqr(a^2 + b^2)

Sqr関数は引数の平方根を返します。
上の条件は、
(a^2 + b^2)の平方根が整数であるときTrueとなり
ピタゴラス数と判断します。

結果はイミディエイトウィンドウに出力します。

コードはこちら

Sub macro110501a()
'ピタゴラス数

    Dim a As Integer, b As Integer, c As Integer
    Dim Var1 As Double, Var2 As Double
    Dim MaxValue As Integer
    MaxValue = 100
   
    For a = 1 To MaxValue
        For b = a To MaxValue
            Var1 = a * a + b * b
            If Int(Sqr(Var1)) = Sqr(Var1) Then
                Var2 = Sqr(Var1)
                If Var1 = Var2 * Var2 Then
                    Debug.Print a & ", " & b & ", " & Var2
                End If
            End If
        Next b
    Next a
   
End Sub

実行後のイミディエイトウィンドウの一部：

ピタゴラス数を求めるとか言う程のプログラムではないですね。
Sqr関数に頼りきっています。

ということで、
このままでもつまらないので
Sqr関数を使わないで平方根を求めてみます。

数学の問題を解くときに
手で計算して無理数の大体の値を求めるときに使う手法で
平方根を近似してみます。

ルート2とかルート3は暗記しているけれど
ルート7までは覚えていないことが多いのではないでしょうか。
そういうときに
手で計算して平方根の大体の値を求めたいことがあります。
ルート7の場合の手順は次のようです。

4 < 7 < 9
2^2 < 7 < 3^2
2 < ルート7 < 3

ですのでルート7は2より大きく3より小さい値です。
次に小数点第一位を求めます。
小さいほうからルート7に近づいていくようにします。

2.1^2
2.2^2
2.3^2
…
2.9^2

のように順番に7(ルート7の2乗)と比較します。
比較して7よりも大きくなったら
１つ前の値を小数点第一位にします。
このようにして求めると、ルート7の小数点第一位は6です。

小数点第二位も同様にして求めます。

2.61^2
2.62^2
2.63^2
…
2.69^2

のように順番に7と比較します。同じように任意の小数点の位まで求めます。

変数pが小数点が第何位かをあらわします。
下のコードの

If p <= -5 Then

の箇所で小数第何位まで求めるかを決めます。
いまは小数第五位までになっています。

結果はイミディエイトウィンドウに出力します。

コードはこちら

Sub macro110501b()
'平方根

    Dim x As Integer
    Dim a As Integer, a2 As Double
    Dim i As Double
    Dim p As Double
    x = 7 '求めるルートの値
    p = -1
   
    '整数部分を求める
    For i = 1 To 1000
        If i * i > x Then
            a = i - 1
            a2 = a
            Exit For
        End If
    Next i
   
    '小数点以下を求める
Step1:
    For i = 10 ^ p To (10 ^ p) * 9 Step 10 ^ p
        If (a2 + i) ^ 2 > x Then
            a2 = a2 + i - (10 ^ p)
            If p <= -5 Then
                '小数第五位までで終了

                GoTo Step2:
            End If
            p = p - 1
            GoTo Step1
        End If
    Next i
   
Step2:
    '結果をイミディエイトに表示
    Debug.Print a2
    Debug.Print Sqr(x)
   
End Sub

実行後のイミディエイトウィンドウ：

上の値が上のコードで求めたルート7、
下がSqr関数で求めたルート7です。