日付か時刻かの判別

Excelでは日付でも時刻でもDate型で扱われ、
型だけでは日付か時刻かの判別がつきません。

そこで日付の長整数型の値を使って
日付か時刻かの判別をしてみます。

というのも

あるWebサイトから
情報をExcelで取り込み加工したいときに
そのサイトでは日付と時刻が別々に表示されていました。

それで、日付と時刻を合わせて1つの情報にするために
日付と時刻を判別する必要があったからでした。

日付か時刻かを判別する条件を
日付と時刻のそれぞれ示します。

時刻の情報がない日付はDate型かつ整数である。
日付のない時刻のみの情報はDate型かつ1より小さい。
（ただし24:00以上の時刻はここでは扱わない。）

この条件を使って日付と時刻の判別をしていきます。

Date型かどうかはIsDate関数を使います。

整数ということは
小数点以下0ということなので
値 = Int(値)がTrueのとき
値は整数です。

1より小さいは
そのまま 値 < 1 です。

日時のシステムについては
以前の記事を検索して参照してください。
またはVBAヘルプにあります。

コードはこちら

Sub macro110327a()
'日付と時刻の判別

    Dim MyValue As Variant
    MyValue = InputBox("日付か時刻かを判別します。")
   
    If IsDate(MyValue) Then
        If CDate(MyValue) = Int(CDate(MyValue)) Then
            MsgBox ("日付のみ")
        ElseIf CDate(MyValue) < 1 Then
            MsgBox ("時刻のみ")
        Else
            MsgBox ("日付のみ、時刻のみの値ではありません。")
        End If
    Else
        MsgBox ("日時ではありません。")
    End If
   
End Sub

実行例：

自作関数CDate2を使えば
24:00以上の時刻も判別可能です。

2次元配列の行列を入れ替える

以前の記事で
セルの範囲の行列の入れ替えを
コピぺで実行する方法を紹介しました。

今回は
2次元配列の行列を入れ替えます。

これには
ワークシート関数のTransposeを使用します。

行列を入れ替えたい配列vDataがあるとすると
これをワークシート関数のTransposeで行列を入れ替えるには
次のようにします。

Application.WorksheetFunction.Transpose(vData)

これがvDataの行列を入れ替えた配列になります。

コードはこちら

Sub macro110326a()
'2次元配列の行列を入れ替える

    '入れ替える配列
    Dim vData As Variant
    '入れ替えた配列
    Dim vData2 As Variant
   
    '入れ替える配列を作成する
    vData = Range("A1:C5")
   
    '配列を入れ替えてvData2にいれる
    vData2 = Application.WorksheetFunction.Transpose(vData)
   
    '入れ替えた配列をシートに出力
    Range("E1").Resize(UBound(vData2, 1), UBound(vData2, 2)) = vData2
   
End Sub

実行前のシート：

実行後のシート：

この関数を使って
シートの行列を入れ替えることもできるようです。

長いですが
下のようにすると範囲A1:C5の行列を入れ替えたものを
E1を左上とする範囲に入れることができます。

   
    Range("E1").Resize(UBound(Application.WorksheetFunction.Transpose(Range("A1:C5")), 1), _
        UBound(Application.WorksheetFunction.Transpose(Range("A1:C5")), 2)) = _
        Application.WorksheetFunction.Transpose(Range("A1:C5"))

MicroTimerを使って処理時間を計測する

ずいぶん前の記事で
MicroTimerについて触れました。

今回はこれを使って
処理時間を計測してみたいと思います。

まずは次のページのMicroTimer関数を
標準モジュールにコピペしてください。
Excel 2007 におけるパフォーマンスの改善

上記ページの説明によると
MicroTimer関数は
マイクロ秒の小数部分まで計測できるとあります。
マイクロ秒は100万分の秒です。

このページのMicroTimer関数の部分から下へ読んでいくと
これを使った計測の方法が詳しく書かれています。

範囲の計算、シートの計算、再計算、完全計算の
4つの場合に分けて処理時間を計算する方法が示されています。

この記事では
以前の記事『 Timer 関数を使って処理時間を計測する 』で紹介した
macro101030aの中の
Timerの部分をMicroTimerで置き換えたかたちで
MicroTimerを利用します。

MicroTimerが返す値の単位は
コードの中の説明によると秒です。

コードはこちら

Sub macro110321a()
'MicroTimerの使い方

    Dim dTime As Double
    dTime = MicroTimer
   
   
    '計測したい処理
   
   
    dTime = MicroTimer - dTime
   
    MsgBox Round(dTime, 5) & "　秒"
   
End Sub

MicroTimer関数の詳細についてはよくわかりません。

getTickCountはmsdnの説明ではミリ秒の値を返すとあるので
これを1000倍すれば秒単位になると思うのですが、
MicroTimer関数の最後で
cyTicks1 / cyFrequency
の計算で秒単位にしているようです。

GetFrequencyについては
何らかの周波数であることは言葉からわかりますが
検索しても明確な説明が見つかりませんでした。

回文判定マクロ

回文とは、
前から読んでも後ろから読んでも同じ文のことです。

Wikipediaによると日本語の回文では
濁音、半濁音、促音、拗音は
清音と同一として考えることが多いようですが
まずはこれらを別物とした回文判定をしてみます。

回文を判定する文はひらがなで入力します。
これを逆に並べた文字列を作成します。
これを元の文と比較して
同じなら回文と判定します。

コードはこちら

Sub Palindrome(Str As String)
'完全回文判定マクロ

    Dim i As Integer
    Dim Str2 As String
   
    '反対から並べ替える
    For i = Len(Str) To 1 Step -1
        Str2 = Str2 + Mid(Str, i, 1)
    Next i
   
    '回文かどうかの判定
    If Str = Str2 Then
        MsgBox "「" & Str & "」は回文です。"
    Else
        MsgBox "「" & Str & "」回文ではありません。" & Chr(10) & _
            "逆は「" & Str2 & "」"
    End If
   
End Sub

Sub macro110319a()
'Palindrome使用例

    Call Palindrome("madamimadam")
   
End Sub

次は
濁音、半濁音、促音、拗音は
清音と同一として考える回文判定をします。

今回もまず最初に逆に並べた文字列を作成します。

回文の判定をする部分ですが
一文字づつ比較していきます。

ひらがなを
濁音、半濁音、促音、拗音のそれぞれの有無で
グループ分けします。

グループ分けは以下のとおり

清音のみのグループ：
あ、な行、ま行、ら行、ゐゑをん
清音と小さい字のみのグループ：
いうえお、やゆよ、わ
清音と濁音のグループ：
か行、さ行、たちてと
清音、濁音、半濁音のグループ：
は行
清音、濁音、小さい字のグループ：
つ

次のコードで
ひらがなと文字コードを
書き出してみるとわかりやすいです。

Sub macro110319b()
'ひらがなと文字コードを出力する

    Dim i As Long
    Sheets.Add
    For i = -32096 To -32015
        Cells(i + 32097, 1) = i
        Cells(i + 32097, 2) = Chr(i)
    Next i
   
End Sub

それぞれの文字の判定はASC関数を使って
文字コードでします。

Selectステートメントで
それぞれのグループ別に分岐して
それぞれ清音、濁音、半濁音、促音、拗音を同一として
もとの文の文字と比較して同一かどうかの
判定をします。

一個でも同一でないと判定されると
変数flagが0より大きい整数になります。
コードはこちら

Sub Palindrome2(Str As String)
'回文判定マクロ

    Dim i As Integer
    Dim Str2 As String
   
    '反対から並べ替える
    For i = Len(Str) To 1 Step -1
        Str2 = Str2 + Mid(Str, i, 1)
    Next i
   
    Dim flag As Integer
    flag = 0
    '回文かどうかの判定
    For i = Len(Str) To 1 Step -1
        Select Case Asc(Mid(Str, i, 1))
            Case -32056 To -32052, -32036 To -32032, -32025 To -32021, -32018 To -32015
            '濁音などなし
                If Mid(Str, i, 1) <> Mid(Str2, i, 1) Then
                    flag = flag + 1
                End If
            Case -32087 To -32064
            '濁音あり(か～ち)
            '偶数が濁音
                If Asc(Mid(Str, i, 1)) Mod 2 = 0 Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                Else
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            Case -32060 To -32057
            '濁音あり(て～と)
            '奇数が濁音
                If Asc(Mid(Str, i, 1)) Mod 2 = 0 Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                Else
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            
            Case -32051 To -32037
            'はばぱ行
                If ((Asc(Mid(Str, i, 1)) + 32051) Mod 3) = 0 Then
                    'は行
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 2) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf ((Asc(Mid(Str, i, 1)) + 32051) Mod 3) = 1 Then
                    'ば行
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf ((Asc(Mid(Str, i, 1)) + 32051) Mod 3) = 2 Then
                    'ぱ行
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 2) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
               
            Case -32063 To -32061
            'つづっ
                If Mid(Str, i, 1) = "つ" Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf Mid(Str, i, 1) = "づ" Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 2) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf Mid(Str, i, 1) = "っ" Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 2) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            Case -32097 To -32088, -32031 To -32026
            'あいうえお、やゆよ（小さい音あり）
                If (Asc(Mid(Str, i, 1)) Mod 2) = 0 Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                Else
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            Case -32020 To -32019
            'ゎわ
                If Mid(Str, i, 1) = "ゎ" Then
                '小さい音
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) - 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                ElseIf Mid(Str, i, 1) = "わ" Then
                    If Mid(Str, i, 1) <> Mid(Str2, i, 1) And _
                        Chr(Asc(Mid(Str, i, 1)) + 1) <> Mid(Str2, i, 1) Then
                        flag = flag + 1
                    End If
                End If
            Case Else
            'その他
                If Mid(Str, i, 1) <> Mid(Str2, i, 1) Then
                    flag = flag + 1
                End If
        End Select
    Next i
   
    If flag = 0 Then
        MsgBox "「" & Str & "」は回文です。"
    Else
        MsgBox "「" & Str & "」回文ではありません。" & Chr(10) & _
            "逆は「" & Str2 & "」" & Chr(10) & _
            "flag = " & flag
    End If
   
End Sub

Sub macro110319c()
'Palindrome2使用例

    Call Palindrome2("つつみがみっつ")
   
End Sub

とりわけ回文を考えることはないけれど、
なんとなく作ってみました。

2次元配列をランダムに並び換える

以前の記事「ランダムに並び替える 」では
セルの内容を乱数を使ってランダムに並び換えました。

今回は配列をランダムに並び換えたいと思います。

上記の記事の方法でも
配列を一回セルに出力してから
ランダムに並び換えて
再び配列に格納するという手順で可能です。

今回は配列のままランダムに並び換えたいわけですが、
考え方はセルの内容をランダムに並び換えるときと同じです。

あるランダムに並べ換えたい2次元配列vDataがあるとします。
vDataのサイズはUbound(vData)行、Ubound(vData, 2)列です。

そこでvDataに1列足したもう1つの配列vData2を作ります。
サイズはUbound(vData)行、Ubound(vData, 2)+1列です。
vData2の1列足した列に乱数を入れて
その列を基準に昇順か降順にソートします。

足した列を削除したものを
元の配列vDataに入れれば
vDataをランダムに並び換えたものになります。

下のコードの説明をします。

aからjまでのアルファベットを順番に入れた配列vDataを
ランダムに並び替えます。

結果を見るために
最後にセルに配列の内容を出力しています。

コードはこちら

Sub macro110312a()
'２次元配列をランダムに並び替える

    Sheets.Add
    Dim i As Integer
   
    '並び替えたい配列を作る
    'aからjまでの文字
    Dim vData() As Variant
    ReDim vData(10, 1)
    For i = 1 To 10
        vData(i, 1) = Chr(96 + i)
    Next i
   
    Dim vData2 As Variant
    vData2 = vData
    '一列足す
    ReDim Preserve vData2(UBound(vData), UBound(vData, 2) + 1)
   
    '足した列に乱数を入れる
    Randomize
    For i = 1 To UBound(vData2, 1)
        vData2(i, UBound(vData, 2) + 1) = Rnd()
    Next i
       
    '配列vData2を
    '1UBound(vData, 2) + 1列目を基準に降順にソートする
    Call BubbleSort3(vData2, UBound(vData, 2) + 1, 1)
   
    '足した列を削除する
    ReDim Preserve vData2(UBound(vData), UBound(vData, 2))
   
    '並び替えた配列を元の配列に入れる
    vData = vData2
   
    'ランダムに並び換えた配列を出カ
    Range("A1").Resize(UBound(vData), UBound(vData, 2)) = vData
   
End Sub

実行後のシートの例：

ここではvDataという配列を作成してから
ランダムに並び替えていますが、
すでに配列がある場合は
vDataにその配列を当てはめて考えてください。

タイトルにあるように
vDataには２次元配列を想定しています。

最大と最小

VBAを使い始めて間もなく困ることは
VBAで最大と最小をどうやって求めるか？
だと思います。

数式に使うMAXとMINのような関数が
当然、VBAの関数にもあると思っていました。

しかし実際にはありません。
最大と最小をVBAで求めるには、
ワークシート関数を使います。

ワークシート関数とは
数式に使うMAXとMINのような関数です。
すべてのワークシート関数がVBAで使えるわけではありません。
リストはVBAヘルプを参照してください。

MAXというワークシート関数をVBAで使うには次のようにします。

Application.WorksheetFunction.Max(1, 4, 7, 9)

上の値は9です。Double型になります。

引数には33個まで指定できます。
引数は数だけでなくRangeや配列も指定できます。
Rangeを引数に指定した例：

Application.WorksheetFunction.Max(Range("A1:D10"))

Rangeを複数指定することもできます。

Application.WorksheetFunction.Max(Range("A1:B10"), Range("C1:D10"))

配列を指定した例：

Dim vData As Variant
vData = Array(1, 4, 2, 6, 7, 3, 10, 33)

Application.WorksheetFunction.Max(vData)

上の値は33です。
Rangeと同様に配列も引数に複数指定できます。

また配列、Range、数値の混合も可能です。

Application.WorksheetFunction.Max(vData, Range("A1:D10"), 1, 4, 7, 9)

最小を求める場合は
上記のMaxの箇所をMinに変更して使ってください。

最大と最小はグラフをVBAで作成するとき
軸の最大と最小を指定するのに便利です。

ただこの方法では
最大値/最小値の配列内での場所やセルの場所はわかりません。