【VBA】Excelはアクティブシートが変わると、処理時間が変わる場合があるようだ

いつもの如く、怪しげな事（？）をゴニョゴニョとやっていて、
「あれ、さっきより処理速くね？」となったので・・・

経緯

ワークシートに５０万件ほどのデータがあって、そいつにフィルターを掛けて外しての繰り返しをやっていたら、何かの拍子に処理時間が早くなったんですよ。
調べてみたら、フィルター処理を行う時に、

フィルターを適用するワークシートをアクティブにしているより、
フィルターを適用しないワークシートをアクティブにしておいた方が

速かったんですよ。

もちろん

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

は適用した上ですよ。
ブックには、式が１つもないので、下２つは、ほとんど意味がないような気がするけど、お約束なので・・・

結果

とりあえず、というか、いきなり結果から。
速度順に並べたが、「フィルターを適用するシート以外のシート」をアクティブにしたケースが全て上位になっている。率にして、15%以上の差が出ており、誤差と言える値ではなさそうである。
「平均処理時間」は、５回実行した結果の平均値。

アクティブシート	ScreenUpdating	WindowState	平均処理時間（秒）	備　　考
非フィルター適用シート	False	xlMinimized	16.31
非フィルター適用シート	False	xlNormal	16.32	Worksheet.Visible = False
非フィルター適用シート	False	xlNormal	16.35
非フィルター適用シート	True	xlMinimized	16.46
非フィルター適用シート	True	xlNormal	16.65	Worksheet.Visible = False
非フィルター適用シート	True	xlNormal	16.67
フィルター適用シート	False	xlNormal	18.85
フィルター適用シート	False	xlMinimized	18.86
フィルター適用シート	True	xlMinimized	21.04
フィルター適用シート	True	xlNormal	25.13

コード

Private Const KEY_COL           As Long = 1

Private Const DATA_SHEET_NAME   As String = "Data"
Private Const KEY_SHEET_NAME    As String = "Key"

Private Const HEADER_ROWS       As Long = 1

Private Const MAX_KEYS_COUNTS   As Long = 50
Private Const MAX_DATAS_COUNTS  As Long = 500000


Public Sub queryByAutoFilter()

    Dim ws          As Worksheet
    Dim r           As Range
    Dim lEndRow     As Long
    Dim sgStart     As Single
    Dim sgStop      As Single
    Dim vKeys()     As Variant
    Dim i           As Long

    Dim lMatchCount As Long

With Application
    .ScreenUpdating = False
'    .ScreenUpdating = True
    .EnableEvents = False
    .Calculation = xlCalculationManual

    .WindowState = xlNormal
'    .WindowState = xlMinimized
End With

sgStart = Timer

    Set ws = Worksheets(DATA_SHEET_NAME)

    lEndRow = MAX_DATAS_COUNTS + HEADER_ROWS

    '検索対象キー値取得
    Call getKeys(vKeys)

    ReDim sKeys(LBound(vKeys) To UBound(vKeys))

    For i = LBound(vKeys) To UBound(vKeys)
        sKeys(i) = CStr(vKeys(i))
    Next i

    With ws
        'Filter対象レンジを設定
        Set r = .Range(.Cells(1, KEY_COL), .Cells(lEndRow, KEY_COL))
    End With

    With r
        For i = LBound(sKeys) To UBound(sKeys)
            'AutoFilterクリア
            .AutoFilter

            'Filter実行
            .AutoFilter Field:=1, Criteria1:=sKeys(i), Operator:=xlFilterValues

            If .SpecialCells(xlCellTypeVisible).Count > HEADER_ROWS Then
                lMatchCount = lMatchCount + .SpecialCells(xlCellTypeVisible).Count - HEADER_ROWS
            End If
        Next i

        'AutoFilter解除
        .AutoFilter
    End With

sgStop = Timer

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic

    .WindowState = xlNormal
End With

    Debug.Print Format$(sgStop - sgStart, "0.00")

End Sub


Private Sub getKeys(ByRef vKeys() As Variant)

    Dim lEndRow   As Long
    Dim lItems  As Long
    Dim lValue  As Long
    Dim i       As Long

    ReDim vKeys(MAX_KEYS_COUNTS - 1)

    lEndRow = MAX_KEYS_COUNTS + HEADER_ROWS

    With Worksheets(KEY_SHEET_NAME)
        For i = HEADER_ROWS + 1 To lEndRow
            vKeys(i - HEADER_ROWS - 1) = .Cells(i, 1).Value
        Next i
    End With

End Sub

まとめ（のようなもの）

• フィルターを適用するワークシートをアクティブにしない方が速かった。
• ScreenUpdateing = False は、フィルターを適用するワークシートがアクティブな場合には、効果が大きいが、そうでない場合は、効果がほとんど認められなかった。
• Windowを最小化しても、あまり高速化へのメリットはなかった。

今回のテストでは、ScreenUpdatingの状態に関わらず、フィルターを適用するワークシートをアクティブにしない方が速くなっている。

では、フィルターを適用するワークシートが「表示されていなければ、いいのか？」というと、
「Windowを最小化」により該当ワークシートを非表示状態にして効果が認められるのは、
フィルターを適用するワークシートをアクティブにして、かつ ScreenUpdating = True の場合だけだったので、表示されていなければ、効果があるわけではないようだ。

一方で、「該当ワークシートを非表示にする」というのは、別のワークシートをアクティブ化するという事と同等なので、これは「効果はある」ことになる。

結局の所、ScreenUpdatingがFalseになっていても、フィルターを適用するワークシートがアクティブの場合には、アクティブシートであるが故の何かが、裏で動いていると考えるのが妥当なのかもしれない。
というか、私の頭ではそれしか思い浮かばない。
誰か、わかる方がいらっしゃいましたら教えて下さい。

フィルター以外でも効果があるのかは、要確認。
でも、きっと・・・
忘れて何もしないような気がする。

追記

行削除（2019/5/5）

行の削除処理で比較してみた。

Public Sub deleteRows(ByVal acsh As Long, ByVal doScreenUpdating As Boolean)

    Const END_ROW   As Long = 10000

    Dim ws      As Worksheet
    Dim sgStart As Single
    Dim sgStop  As Single
    Dim i       As Long

sgStart = Timer

    Application.ScreenUpdating = doScreenUpdating

    If acsh = 1 Then
        Worksheets(1).Activate
    Else
        Worksheets(2).Activate
    End If

    Set ws = Worksheets(1)

    With ws
        .Cells.ClearContents

        .Cells(1, 1).Value = 1
        .Cells(2, 1).Value = 2

        .Range("A1:A2").AutoFill Destination:=.Range("A1:A" & CStr(END_ROW)), Type:=xlFillDefault

        For i = END_ROW To 1 Step -2
            .Rows(i).Delete
        Next i
    End With

    Worksheets(1).Activate

    Application.ScreenUpdating = True

sgStop = Timer

    Debug.Print "Active Sheet:" & CStr(acsh), Format$(sgStop - sgStart, "0.00")

End Sub

結果

Active Sheet: 1 ScreenUpdating: True Time[sec]: 3.64
Active Sheet: 1 ScreenUpdating: False Time[sec]: 0.97
Active Sheet: 2 ScreenUpdating: True Time[sec]: 0.89
Active Sheet: 2 ScreenUpdating: False Time[sec]: 0.84

やっぱり、処理するシート以外をアクティブシートにした方が速い。
その場合には、ScreenUpdating = False としても、大きな効果は認められない。（見えない所で処理しているのだから、当たり前といえば当たり前か・・・）
結構使えるかもしれない・・・

【VBA】割り算を使わないで、数値の２進数表示を取得する（負値対応済み）

最初に断っておきますが、この記事は半分ネタです。
あえて、面倒くさいことしてます。
私がやりたかっただけです。

基本に則って２進表示を求めたい方は、

• ググる
• WorksheetFunction.Dec2Bin

とか、して下さい。

但し、10進数の２進数表示した文字列を取得する関数は、探せば結構出てきますが
大体は、２で割って余りを求めて・・・
でも、負の数まで考慮されているものはほとんど無いようです。
私が見つけた１件でも、値によってはオーバーフローして、十分な検証はされていないようでした。

WorksheetFunction.Dec2Bin は、

数値 < -512 または数値 > 511 の場合、エラー値 #NUM! が返されます。

WorksheetFunction.Dec2Bin メソッド (Excel)

と、あまり使い物にならないかもしれません。

コード　その１

割り算を使った方法は、上位の桁から処理していくが、割り算を使用しないということは、その逆で、下位から処理を行っていきます。
2^0 の桁 から Integerなら、2^15 の桁に向かって処理を行います。

流れとしては
最初に、変換したいデータと 1 （ = 2^0 ）のAnd を取る。

奇数の場合、2^0の桁は 1 なので
1 And 1 ===> 1
となり、
偶数の場合、2^0の桁は 0 なので
0 And 1 ===> 0
となる。

And を取った結果が、2^0 の桁の値となる。

これを桁を、2^1の桁、2^2の桁と、上位方向にずらして繰り返していく。

「And演算子って何？」とか、
「なんで数値同士でAndなの？」とか
「A And B って、A かつ B じゃないの？」
という方は、以下のリンクをどうぞ。
（解説の下の方に書いてあります。）
docs.microsoft.com

以下が、その処理を行うコードです。
但し、Integer も Long も符号付き故に、大抵は、最上位bitでの処理に苦しみます。（多分、私だけではないと思う。）
結局は、それを回避するためにゴチャゴチャと・・・

▶Integer（16bit 符号付き）版

Public Function Dec2Bin16(ByVal iDecValue As Integer) As String

    Dim sBin        As String
    Dim iBitMask    As Integer
    Dim iMask       As Integer
    Dim lBitIndexR  As Long

    Const BIT_ON_FULL               As Integer = &HFFFF
    Const BIT_ON_TOP_BIT_ONLY       As Integer = &H8000
    Const BIT_ON_SECONT_BIT_ONLY    As Integer = &H4000
    Const BIT_LENGTH                As Long = 16

    If iDecValue = 0 Then
        '0
        Dec2Bin16 = String$(BIT_LENGTH, "0")

        Exit Function
    ElseIf iDecValue < 0 Then
        If iDecValue = -1 Then
            '-1
            Dec2Bin16 = String$(BIT_LENGTH, "1")

            Exit Function
        ElseIf iDecValue = BIT_ON_TOP_BIT_ONLY Then
            '&H8000
            Dec2Bin16 = "1" & String$(BIT_LENGTH - 1, "0")

            Exit Function
        End If
    End If

    '復帰用文字列
    sBin = String$(BIT_LENGTH, "0")

    '特定のbitとAndを取るためのマスク
    iBitMask = 1

    '処理するbit位置（最下位：一番右が、1。上位に移動する毎に、2、3・・・と増える）
    lBitIndexR = 1

    '上位にbitが立っているかによりループ終了を判定するためのマスク
    iMask = BIT_ON_FULL

    Do Until (iDecValue And iMask) = 0
        If (iDecValue And iBitMask) = iBitMask Then
            '指定bitが立っていたら、結果用のデータを更新
            Mid$(sBin, BIT_LENGTH - lBitIndexR + 1, 1) = "1"
        End If

        'マスクを左シフト
        iMask = iMask And (Not iBitMask)

        lBitIndexR = lBitIndexR + 1

        If (iBitMask And BIT_ON_SECONT_BIT_ONLY) = 0 Then
            'マスクを左シフト
            iBitMask = iBitMask * 2
        Else
            '最上位のBitをセットするとオーバーフローするので、ループを抜ける
            Exit Do
        End If
    Loop

    '最上位Bit
    If (iDecValue And BIT_ON_TOP_BIT_ONLY) = BIT_ON_TOP_BIT_ONLY Then
        Mid$(sBin, 1, 1) = "1"
    End If

    Dec2Bin16 = sBin

End Function

▶Long（32bit 符号付き）版

Public Function Dec2Bin32(ByVal lDecValue As Long) As String

    Dim sBin        As String
    Dim lBitMask    As Long
    Dim lMask       As Long
    Dim lBitIndexR  As Long

    Const BIT_ON_FULL               As Long = &HFFFFFFFF
    Const BIT_ON_TOP_BIT_ONLY       As Long = &H80000000
    Const BIT_ON_SECONT_BIT_ONLY    As Long = &H40000000
    Const BIT_LENGTH                As Long = 32

    If lDecValue = 0 Then
        Dec2Bin32 = String$(BIT_LENGTH, "0")

        Exit Function
    ElseIf lDecValue < 0 Then
        If lDecValue = -1 Then
            Dec2Bin32 = String$(BIT_LENGTH, "1")

            Exit Function
        ElseIf lDecValue = BIT_ON_TOP_BIT_ONLY Then
            Dec2Bin32 = "1" & String$(BIT_LENGTH - 1, "0")

            Exit Function
        End If
    End If

    sBin = String$(BIT_LENGTH, "0")

    lBitMask = 1
    lBitIndexR = 1

    lMask = BIT_ON_FULL

    Do Until (lDecValue And lMask) = 0
        If (lDecValue And lBitMask) = lBitMask Then
            Mid$(sBin, BIT_LENGTH - lBitIndexR + 1, 1) = "1"
        End If

        lMask = lMask And (Not lBitMask)

        lBitIndexR = lBitIndexR + 1

        If (lBitMask And BIT_ON_SECONT_BIT_ONLY) = 0 Then
            lBitMask = lBitMask * 2
        Else
            '最上位のBitをセットするとオーバーフローするので、ループを抜ける
            Exit Do
        End If
    Loop

    '最上位Bit
    If (lDecValue And BIT_ON_TOP_BIT_ONLY) = BIT_ON_TOP_BIT_ONLY Then
        Mid$(sBin, 1, 1) = "1"
    End If

    Dec2Bin32 = sBin

End Function

Long（32bit 符号付き）版のコードは、必要最小限にコメントを省いているので、コメントが必要な方は、Integer（16bit 符号付き）版のコメントを参照して下さい。
微妙に違うところはありますが、ほぼ分かると思います。

コード　その２

VBAで、エンディアンの変換をやろうとしたら、やっぱりハマった - 空腹おやじのログと備忘録 のおまけで書いたコードと似たような手法。

最初に変換したい値を16進の文字列に変換して、16進数１文字につき、2進数４文字に変換していく。
値の正負を意識する必要がない。
オーバーフローの心配もなく、手っ取り早い。

お気軽に使いたいなら、こちらの方がおすすめ。

Integer（16bit）版のみ掲載
Long(32bit)版が欲しい方は、適当にアレンジして下さい。そんなに難しくはないと思いますので。

▶Integer（16bit）版

Public Function Dec2BinS16(ByVal iDecValue As Integer) As String

    Dim sHex    As String
    Dim sBin    As String
    Dim i       As Long

    Static sHB(15) As String
    Static isInitialized    As Boolean

    If isInitialized = False Then
        sHB(0) = "0000"
        sHB(1) = "0001"
        sHB(2) = "0010"
        sHB(3) = "0011"
        sHB(4) = "0100"
        sHB(5) = "0101"
        sHB(6) = "0110"
        sHB(7) = "0111"
        sHB(8) = "1000"
        sHB(9) = "1001"
        sHB(10) = "1010"
        sHB(11) = "1011"
        sHB(12) = "1100"
        sHB(13) = "1101"
        sHB(14) = "1110"
        sHB(15) = "1111"

        isInitialized = True
    End If

    sHex = Right$(String$(3, "0") & Hex(iDecValue), 4)

    sBin = String$(16, "0")

    For i = 0 To 3
        Mid$(sBin, i * 4 + 1, 4) = sHB(CInt("&H" & Mid$(sHex, i + 1, 1)))
    Next i

    Dec2BinS16 = sBin

End Function

あぁ、今日も自己満足の世界に・・・

【VBA】For ループの罠（？）

次のコードを実行するとどうなると思いますか？

Public Sub foo()

    Dim i   As Long

    For i = &H7FFFFFFE To &H7FFFFFFF
        Debug.Print i
    Next i

End Sub

もうひとつ

Public Sub bar()

    Dim i   As Long

    i = &H7FFFFFFE

    Do
        Debug.Print i

        i = i + 1
    Loop Until i > &H7FFFFFFF

End Sub

ちなみに、
&H7FFFFFFE => 2147483646
&H7FFFFFFF => 2147483647
です。

どちらも、

 2147483646 
 2147483647 

となると思った方

　　　・
　　　・
　　　・
　　　・
　　　・

残念ですが、半分だけ正解です。

bar の方が、予想はしやすいと思いますが・・・

どちらも 2147483646 と 2147483647 は出力されます。
でもその後に、どちらも、オーバーフローが発生します。

上記Forループの場合、変数 i がLongなので、Longの上限値である &H7FFFFFFF までループ可能かと思っていたら、内部で&H7FFFFFFF + 1 してからループを終了するみたいです。
（ i = &H7FFFFFFF の処理を終了後、i をインクリメントして　i > &H7FFFFFFF となったことでループ終了と判断していると推測される）
ただ、For ループの方のスクリーンショットで見える -2147483648 は、Long の最小値（&H80000000）であるので、この状況についてはよくわからない。
Longの上限（&H7FFFFFFF）を超えた &H80000000（正の値）が、Longの変数領域に負の値の &H80000000 として存在しているためなのか？
内部でのBitは　&H80000000　で一致していても、実際には、Longの上限（&H7FFFFFFF）+1（＋2147483648 > 0）となるためオーバーフローと判断されたのだろうか？

ちなみに、イミディエイトウィンドウで

? &H7FFFFFFF + 1

とやっても、オーバーフローが発生する。

上記のbarの方は予想はできるけど、For の挙動は予想できなかった。

別の作業で同様の処理をやっていて、順調に進んでいった最後のところで
「えっ、なんでオーバーフローすんの？」って驚いた。
その原因がこんな感じでした。

結　　論

• For ループは、ループ変数の型の上限値までループさせるとオーバーフローする。
• ループ変数の型は、余裕のあるサイズにしよう！！！
• 境界には気をつけよう

あぁ、今日も余計な手間で疲れた・・・

回答が・・・

後からブロググループのページを見て・・・
がっかり orz

なんのために結果を隠したんだよ・・・
最初から答えが出てるじゃん。

当該画像の前に別の画像を追加しても、ブログページに表示される画像は変わらないんですね。
しょうがないので、最初から隠さずに全部表示することにしました。

つまらん！

VBAのDictionary の Key について実験してみた

VBAのDictionaryのKeyには、数値、文字（数字を含む）、オブジェクト等が使えます。
そんな中で、ちょっと気になったことがあったので、実験してみました。

データ型が異なる同一値の数値を指定してみる

「データ型が異なる別々の値」をKeyとしてDictionaryに追加した後、それぞれのItemを、「値が同じで、異なるデータ型」のKeyを指定して呼び出してみる。

１．呼び出し検証コード

Public Sub 数値型追加テスト()

    Dim dic As New Dictionary
    Dim v   As Variant

    dic.Add CByte(0), "Byte"
    dic.Add 1, "Integer"
    dic.Add 2&, "Long"
    dic.Add 3@, "Currency"
    dic.Add 4!, "Single"
    dic.Add 5#, "Double"

    For Each v In dic.Keys
        Debug.Print TypeName(v), v
    Next v

    Debug.Print "----- " & "Integer" & " -----"
    Debug.Print dic(0)
    Debug.Print dic(1)
    Debug.Print dic(2)
    Debug.Print dic(3)
    Debug.Print dic(4)
    Debug.Print dic(5)

    Debug.Print "----- " & "Long" & " -----"
    Debug.Print dic(0&)
    Debug.Print dic(1&)
    Debug.Print dic(2&)
    Debug.Print dic(3&)
    Debug.Print dic(4&)
    Debug.Print dic(5&)

    Debug.Print "----- " & "Currency" & " -----"
    Debug.Print dic(0@)
    Debug.Print dic(1@)
    Debug.Print dic(2@)
    Debug.Print dic(3@)
    Debug.Print dic(4@)
    Debug.Print dic(5@)

    Debug.Print "----- " & "Single" & " -----"
    Debug.Print dic(0!)
    Debug.Print dic(1!)
    Debug.Print dic(2!)
    Debug.Print dic(3!)
    Debug.Print dic(4!)
    Debug.Print dic(5!)

    Debug.Print "----- " & "Double" & " -----"
    Debug.Print dic(0#)
    Debug.Print dic(1#)
    Debug.Print dic(2#)
    Debug.Print dic(3#)
    Debug.Print dic(4#)
    Debug.Print dic(5#)

    Debug.Print "----- " & "Type Name" & " -----"
    Debug.Print TypeName(dic.Keys(0))
    Debug.Print TypeName(dic.Keys(1))
    Debug.Print TypeName(dic.Keys(2))
    Debug.Print TypeName(dic.Keys(3))
    Debug.Print TypeName(dic.Keys(4))
    Debug.Print TypeName(dic.Keys(5))

End Sub

実行結果

call 数値型追加テスト
Byte           0 
Integer        1 
Long           2 
Currency       3 
Single         4 
Double         5 
----- Integer -----
Byte
Integer
Long
Currency
Single
Double
----- Long -----
Byte
Integer
Long
Currency
Single
Double
----- Currency -----
Byte
Integer
Long
Currency
Single
Double
----- Single -----
Byte
Integer
Long
Currency
Single
Double
----- Double -----
Byte
Integer
Long
Currency
Single
Double
----- Type Name -----
Byte
Integer
Long
Currency
Single
Double

• 同一値であれば、データ型が異なっていてもItemを呼び出しできる。
• 呼び出したItemは、Addした際のデータ型を保持している。

おまけのテスト

Public Sub hoge()

    Dim v1
    Dim v2

    v1 = 10
    v2 = 10&

    Debug.Print v1 = v2
    Debug.Print TypeName(v1) = TypeName(v2)

    Debug.Print 10 = 10&
    Debug.Print TypeName(10) = TypeName(10&)

End Sub

実行結果

call hoge
True
False
True
False

これなら、上のような結果になるのは納得。

２．追加検証コード
データ型が異なる同一値をKeyとしてDictionaryに追加してみる。

Public Sub 数値型追加テスト2()

    Dim dic As New Dictionary
    Dim v   As Variant

    dic.Add CByte(0), "Byte"
    dic.Add 0, "Integer"
    dic.Add 0&, "Long"
    dic.Add 0@, "Currency"
    dic.Add 0!, "Single"
    dic.Add 0#, "Double"

End Sub

実行結果

• データ型が異なっていても、値が同一であれば追加はできない。

Nullを指定してみる

検証コード

Public Sub Null追加テスト()

    Dim dic As New Dictionary

    dic.Add Null, "NULL"

    Debug.Print dic.Exists(Null), dic.Item(Null)

End Sub

実行結果

call Null追加テスト
True          NULL

• NullはKeyとして追加できる。
• NullがKeyとして存在するか確認できる。
• Nullをキーとして、Itemを呼び出せる。

空文字列を指定してみる

Public Sub NullString追加テスト()

    Dim dic As New Dictionary

    dic.Add "", "Null String"

    Debug.Print dic.Exists(""), dic.Item("")

End Sub

実行結果

call NullString追加テスト
True          Null String

• 空文字はKeyとして追加できる。
• 空文字がKeyとして存在するか確認できる。
• 空文字をKey指定してItemを呼び出せる。

Binaryを指定してみる

検証コード

Public Sub Binary追加テスト()

    Dim dic As New Dictionary

    dic.Add vbTab, "Tab"
    dic.Add vbCr, "CR"
    dic.Add vbLf, "LF"
    dic.Add vbCrLf, "CRLF"
    dic.Add vbNullChar, "\0"

    Debug.Print dic.Exists(vbTab), dic.Item(vbTab)
    Debug.Print dic.Exists(vbCr), dic.Item(vbCr)
    Debug.Print dic.Exists(vbLf), dic.Item(vbLf)
    Debug.Print dic.Exists(vbCrLf), dic.Item(vbCrLf)
    Debug.Print dic.Exists(vbNullChar), dic.Item(vbNullChar)

End Sub

実行結果

call Binary追加テスト
True          Tab
True          CR
True          LF
True          CRLF
True          \0

• BinaryはKeyとして追加できる。
• BinaryがKeyとして存在するか確認できる。
• BinaryをKey指定してItemを呼び出せる。

テスト後に気が付いたけど、Binaryって、要はByteデータなので、当たり前なのかも。

配列を指定してみる

検証コード

Public Sub 配列追加テスト()

    Dim dic As New Dictionary
    Dim ar11(1)     As Long

    ar11(0) = 11
    ar11(1) = 12

    dic.Add ar11(0), ar11(0) * 10
    dic.Add ar11(1), ar11(1) * 10

    Debug.Print dic.Exists(ar11(0)), dic.Item(ar11(0))
    Debug.Print dic.Exists(ar11(1)), dic.Item(ar11(0))
    Debug.Print dic.Exists(11), dic.Item(11)
    Debug.Print dic.Exists(12), dic.Item(12)


    dic.Add ar11, ar11(0) * 100 + ar11(1) * 100

    Debug.Print dic.Exists(ar11), dic.Item(ar11)

End Sub

実行結果

• 配列の要素は、Keyとして追加できる。
• 配列の要素がKeyとして存在するか確認できる。
• 配列の要素をKey指定してItemを呼び出せる。
• 配列は、Keyとして追加できない。

VBAの＄付きの文字列関数

VBAの文字列関数には＄付きの物がありますが、ネットで見るコードではほとんど見かけません。Microsoftのサイトで関数を検索しても、出てくるのは$なしばかり。

何が違うのと言われれば、

VBA の文字列関数の中には 2 種類のバリエーションを持つものがあります。1 つは文字列を返し、もう 1 つは文字列型 (String) のバリアント値を返します。文字列を返す関数名にはドル記号 ($) が含まれます。たとえば、Chr$、Format$、LCase$、Left$、LTrim$、Mid$、Right$、RTrim$、Space$、Trim$、UCase$ などがあります。文字列型のバリアント値を返す関数にはドル記号は含まれません。これらの関数名は、Chr、Format、Lcase、Left、Ltrim、Mid、Right、Rtrim、Space、Trim、Ucase などになります。前者の関数はすばやく結果を返しますが、Null 値を使用して呼び出すとエラーが発生します。文字列型のバリアント値を返す関数では、Null 値を問題なく使用できます。

文字列の一部を返す | Microsoft Docs

２つの違いをざっくり言うと、

• 復帰値の型が異なる
• パフォーマンスが異なる（通常なら無視できるレベル）
• 文字列を取り出す元の文字列式で扱えるデータの型が異なる

です。

項目	$付き	$なし
復帰値	文字列型 (String)	文字列型 (String) のバリアント値
Null値対応	使用不可	使用可

Nullをパラメータとして渡した場合の違いはこんな感じ。
$なしは、エラーの発生もなく、Null（文字列ではない）を返している。
　　 文字列ではないというのは、
　　　? typename(Left(Null,2))
　　と実行すれば
　　　Null
　　と返ってくることで確認できる。
$ありでは、実行時エラー '94'が発生している。

$ありなしでのパフォーマンスの比較は、以下のサイトで行われていたが
基本的には記述通り、$あり ＞ $なし　となっている。
代入先の変数の型で状況が変わるのは、なるほどといった感じ。

■T'sWare Access Labo #32 〜＄付き関数のメリットとは？〜

別に、$付きでも$なしでも、どっちを使ってもいいんですよ。最終的に、正しい結果が得られるのであれば・・・

ちなみに私は、$付き派です。

「だから、どうした？」とか「どうして？」と聞かれても困りますが・・・

VBAで、エンディアンの変換をやろうとしたら、やっぱりハマった

Windowsを使っていると、ソケット通信のコーディングでもしない限り、ほとんど意識する事がないであろうビッグエンディアンとリトルエンディアンに関する事です。

まず、「エンディアンって何それ美味しいの？」って人は、こちらをどうぞ。
ja.wikipedia.org

やろうとしているのは、1Byte単位で、上位下位を入れ替えるというもので、例えば、
Integerなら、１６進表記で、&H1234 を &H3412 に
Longなら、１６進表記で、&H12345678 を &H78563412
に変換するというものです。

まず、Integerから。サクッとこんな感じかな？

Public Function convertEndian16NG(ByVal iValue As Integer) As Integer

    Dim byHighByte  As Byte
    Dim byLowByte   As Byte

    byHighByte = (iValue And &HFF00) \ &H100
    byLowByte = iValue And &HFF

    convertEndian16NG = (byLowByte * &H100) Or byHighByte

End Function

じゃあ、テスト。

? hex(convertEndian16NG(&H1234))
3412

OK。もうひとつ。

? hex(convertEndian16NG(&H8765))

orz

何処？

? hex(iValue And &HFF00)
8700

OK

? typename(iValue And &HFF00)
Integer

OK

? hex((iValue And &HFF00)\&H100)
FF87

ん？？？
87 になるはずが、FF87 になってる！
最上位ビットが1だから（別の言い方をすれば、負の値だから）、右シフトしてきた時に、頭が0でなくて、1になるのか・・・
忘れてた。

じゃあ、最上位ビットが "1" でなければいいから、強制的に Long になるように
iValue と And を取る &HFF00 を Integer から Long に変えるおまじないをしよう。（ &HFF00 → &HFF00& ）

? &HFF00
-256 
? &HFF00&
 65280 

Public Function convertEndian16NG2(ByVal iValue As Integer) As Integer

    Dim byHighByte  As Byte
    Dim byLowByte   As Byte

    byHighByte = (iValue And &HFF00&) \ &H100
    byLowByte = iValue And &HFF

    convertEndian16NG2 = (byLowByte * &H100) Or byHighByte

End Function

再テスト

? hex(convertEndian16NG2(&H1234))
3412

? hex(convertEndian16NG2(&H8765))
6587

OK。
もうひとつ

? hex(convertEndian16NG2(&H1080))

orz
今度は何処ですか・・・

? byLowByte * &H100

32768（&H8000 ::正値　Integerで &H8000 は、-32768）だから、Integerの上限値（32767 : &H7FFF）を超えてしまうのね。
Byte と Integer の掛け算だから、Integerになる想定だったのに、Integerに収まらなくてオーバーフローになっちゃうのね。

じゃあ、下位の1Byteは最上位ビットを除いて処理して、後からその分を補正してやろう。

Public Function convertEndian16(ByVal iValue As Integer) As Integer

    Dim byHighByte  As Byte
    Dim byLowByte   As Byte
    Dim iNewValue   As Integer

    byHighByte = (iValue And &HFF00&) \ &H100
    byLowByte = iValue And &HFF

    iNewValue = ((byLowByte And &H7F) * &H100) Or byHighByte

    If (byLowByte And &H80) = &H80 Then
        iNewValue = iNewValue Or &H8000
    End If

    convertEndian16 = iNewValue

End Function

再々テスト

? hex(convertEndian16(&H1234))
3412

? hex(convertEndian16(&H8765))
6587

? hex(convertEndian16(&H1080))
8010

? hex(convertEndian16(&HFEDC))
DCFE

? hex(convertEndian16(&H0F08))
80F

? hex(convertEndian16(&HFFFF))
FFFF

? hex(convertEndian16(0))
0

とりあえず、良さげ。

以上を踏まえて、Long版は・・・
と行こうかと思ったら、Longの場合、Integerの場合のように、上位の整数型が無いから出来ないじゃん。
（64bitバージョンには、LongLongがあるの？うちの娘に入ってるの、32bitバージョンだから・・・）

ここまでやっておいて、どうするつもりなの？？？

　　　・
　　　・
　　　・
　　　・
　　　・

今更なんですが、IntegerでもLongでも、もっと簡単に出来る方法を思いついちゃったんですよ。

▶見るとがっかりするかもしれませんよ

Public Function convertEndian16S(ByVal iValue As Integer) As Integer

    Dim sOldValue   As String
    Dim sNewValue   As String

    sOldValue = Right$("000" & Hex(iValue), 4)

    sNewValue = String$(4, "0")

    Mid$(sNewValue, 1, 2) = Mid$(sOldValue, 3, 2)
    Mid$(sNewValue, 3, 2) = Mid$(sOldValue, 1, 2)

    convertEndian16S = CInt("&H" & sNewValue)

End Function

Public Function convertEndian32S(ByVal lValue As Long) As Long

    Dim sOldValue   As String
    Dim sNewValue   As String

    sOldValue = Right$(String$(7, "0") & Hex(lValue), 8)

    sNewValue = String$(8, "0")

    Mid$(sNewValue, 1, 2) = Mid$(sOldValue, 7, 2)
    Mid$(sNewValue, 3, 2) = Mid$(sOldValue, 5, 2)
    Mid$(sNewValue, 5, 2) = Mid$(sOldValue, 3, 2)
    Mid$(sNewValue, 7, 2) = Mid$(sOldValue, 1, 2)

    convertEndian32S = CLng("&H" & sNewValue)

End Function

これならミドルエンディアンでも変換出来そう。

結論
エンディアンの変換は、文字列でやるのがお手軽!

さっきまでの前振りは何だったの？

おまけ

データ型	識別子の型文字
Integer	%
Long	&
Decimal	@
Single	!
Double	#
String	$

? typename(1)
Integer

? typename(1%)
Integer

? typename(1&)
Long

? typename(1@)
Currency

? typename(1!)
Single

? typename(1#)
Double

ExcelのAutoFilterの抽出条件には、配列が指定できる・・・でも、ちょっと注意しないといけない事もある

AutoFilterの抽出条件に配列が使用できるとの事で、試してみた際にハマったので・・・

こんなデータを用意。

まずは、１件抽出するコード。こんな感じ？

Public Sub doAutoFilter()

    Dim r   As Range

    Set r = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion

    r.AutoFilter Field:=1, Criteria1:=3

End Sub

実行してみる。

３が抽出されている。問題ない。

では、３件抽出してみる。

Public Sub doAutoFilter2()

    Dim r   As Range

    Set r = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion

    r.AutoFilter Field:=1, Criteria1:=Array(2, 4, 6), Operator:=xlFilterValues

End Sub

実行。

？１件も抽出されない。

「マクロの記録」で同じことをやってみる。

Sub Macro1()
'
' Macro1 Macro
'
'
    Range("A1:A21").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$A$21").AutoFilter Field:=1, Criteria1:=Array("2", _
        "4", "6"), Operator:=xlFilterValues
End Sub

？？？抽出するデータが数値なのに、Arrayの中身が文字列になっている！！！

じゃあ、こう？

Public Sub doAutoFilter2()

    Dim r   As Range

    Set r = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion

'    r.AutoFilter Field:=1, Criteria1:=Array(2, 4, 6), Operator:=xlFilterValues
    r.AutoFilter Field:=1, Criteria1:=Array("2", "4", "6"), Operator:=xlFilterValues

End Sub

大丈夫そう。

セルのデータの型に関係なく、Arrayの中身は、文字列でないと駄目らしい・・・

ということは、セルの書式が変わると抽出されないのでは？
セルの表示を小数第１位まで表示させたら・・・


やっぱり抽出されません。　orz
勘弁して下さい・・・

やっぱり日付でも・・・