B-Teck!

お仕事からゲームまで幅広く

2017年になってました

雑記

今更ですが新年のご挨拶です。

去年は母の急逝然り、人間関係然り、後悔を残すことの多い一年でした。
人間、いつ何があるのかわからないなぁという感じで、
やろうと思ってることができなくなってしまうなんて当たり前にあるんですよね。
自分と向き合う時間、他人と向き合う時間、それぞれを大事にして、
今年一年はなるべく後悔しない、前向きでやり残しのない一年にしたいです。

そういえば、去年末は月間アクセス数が1万の大台目前まできたみたいです。
ブログの性格上、固定の読者さんはあまりおらず、検索経由で来られる方がほとんどだと思いますが、
今年もまた一年のんびり書いていきますので、どうぞよろしくお願いしますね。

【VBA】パスワードのかかっていないExcelだけ開く

VBA

VBAからパスワードのかかったExcelファイルを開く際、普通にWorkbooks.Openするとパスワード入力ダイアログで止まってしまう。
この場合、パスワードを入力するかダイアログを閉じるまで実行中の処理が停止してしまう。
また、ダイアログを閉じた場合にはエラーが発生してしまう。

とりあえず下記方法で回避することができる

  • On Error Resume Nextでエラー発生時に後続の処理が実行されるようにする
  • Open時のパスワード引数に空文字「""」を指定する
  • Open後、Err.NumberがOpen失敗「1004」であるかを確認する
    ※ ループ等の場合、Err.Clearをしないとエラー情報が残ってしまうので注意

ただ少し問題があって、この方法では、パスワードのかかったExcel以外にも開けないExcelが存在したとき(編集中等)に同様に開けないファイルとして扱ってしまう。
どうするのがベストなんだろう。

Sub openExcel(ByVal filePath As String)
    Dim wkBook      As Workbook: Set wkBook = Nothing
    Dim xlApp       As Object: Set xlApp = CreateObject("Excel.Application")
    
'Errorを無視
On Error Resume Next

    'パスワードに空文字を入れることで、パスワード無しで開けるブックのみ開く
    Set wkBook = xlApp.Workbooks.Open(filePath, Password:="")
    'オープン失敗時はエラーメッセージ
    Select Case Err.Number
        Case 1004
            MsgBox "ワークブックにパスワードがかかっているためOpenできません。"
            Err.Clear
        Case 0
            MsgBox filePath & "をOpenしました。"
    End Select
    
    '後処理
    xlApp.Close
    Set xlApp = Nothing
End Sub

【VBA】配列をソートする

VBA 
'/**
' * quickSort
' * 配列をクイックソートする
' * 大小比較できる型ならとりあえずソートできるはず
' * @param  Variant       aryVal sort対象配列
' * @param  Optional Long left   sort範囲左
' * @param  Optional Long right  sort範囲右
' * @return sort後配列
' */
Sub quickSort(ByRef aryVal As Variant, Optional ByVal left As Long = -1, _
                                       Optional ByVal right As Long = -1)
    Dim l As Long
    Dim r As Long
    Dim pivot As Variant
    Dim tmp As Variant

    If left = -1 Or right = -1 Then
        left = LBound(aryVal)
        right = UBound(aryVal)
    End If
    
    l = left
    r = right
    'ソート範囲の中央の値を取得
    pivot = aryVal(Int((left + right) / 2))
    
    Do
        '配列の先頭から、中央の値より大きいものを探す
        Do While aryVal(l) < pivot
            l = l + 1
        Loop
        '配列の末尾から、中央の値より小さいものを探す
        Do While aryVal(r) > pivot
            r = r - 1
        Loop
        
        'ソートの必要がなければループ終了
        If l >= r Then Exit Do
        
        '前半部の大きい値と後半部の小さい値を入れ替える
        tmp = aryVal(l)
        aryVal(l) = aryVal(r)
        aryVal(r) = tmp
        
        l = l + 1
        r = r - 1
    Loop
    
    'ソートが終わるまで再帰的に自分を呼び出し
    If (left < l - 1) Then
        Call quickSort(aryVal, left, l - 1)
    End If
    
    If (right > r + 1) Then
        Call quickSort(aryVal, r + 1, right)
    End If
End Sub

'/**
' * bubbleSort
' * 配列をバブルソートする
' * 大小比較できる型ならとりあえずソートできるはず
' * @param  aryVal sort対象配列
' * @return sort後配列
' */
Sub bubbleSort(ByRef aryVal As Variant)
    Dim i As Long
    Dim j As Long
    Dim tmp As Variant
    
    For i = 0 To UBound(aryVal)
        For j = UBound(aryVal) To i Step -1
            If aryVal(i) > aryVal(j) Then
                tmp = aryVal(i)
                aryVal(i) = aryVal(j)
                aryVal(j) = tmp
            End If
        Next j
    Next i
End Sub
'テスト用
Sub test()

    Dim aryQuick() As Variant: ReDim aryQuick(0)
    Dim aryBubble() As Variant: ReDim aryBubble(0)
    Dim i As Long
    '乱数で配列生成
    For i = 0 To 10000
        ReDim Preserve aryQuick(UBound(aryQuick) + 1)
        aryQuick(UBound(aryQuick)) = Int(Rnd * 10000)
        
        ReDim Preserve aryBubble(UBound(aryBubble) + 1)
        aryBubble(UBound(aryBubble)) = Int(Rnd * 10000)
    Next i
    
    'クイックソート開始
    Debug.Print Now()
    Call quickSort(aryQuick)
    'クイックソート終了
    'バブルソート開始
    Debug.Print Now()
    Call bubbleSort(aryBubble)
    'バブルソート終了
    Debug.Print Now()
End Sub