勉強メモ8_VBAを利用して月毎のアクセス時間の一覧から日毎の同時アクセスの最大回数を取得しExcelに貼り付け

1. はじめに、仕様など

　①VBAを利用して月毎のアクセス時間の一覧から日毎の同時アクセスの最大回数を取得し
　　Excelに貼り付ける。

　②例えば、14時に2回、15時に2回と同じアクセス回数が重なった時は、時間の出力はなし。
　　あくまで日ごとの最大のアクセス回数なので、この場合は出力されるアクセス回数は2回となる。

　③VBAのDictionaryオブジェクトを利用するため、
　　事前に「ツール」→「参照設定」で「Microsoft Scripting Runtime」にチェックを入れる。

　④使い方として新規のExcelを開いて、「Sheet1」シートを作成。
　　表とボタンとVBAを作成し、ボタンにマクロを記録し、ボタンを押下したらマクロが実行される。
　　実行のイメージは以下↓↓
　　

　茶色の実行ボタンを押下すると、
　下記↓↓の様に結果日付とアクセス回数に日付ごとの最大アクセス回数を出力。
　下の場合、9月7日の14時18分が9月7日の中で同時アクセスが1番多いのが4回なので、
　最大アクセス回数は4回になる。

　
　

2. 作成したVBAのコード

Sheet1

Sub outMostAccessCountOfDay()
    MsgBox "処理を開始します。"
    '画面の更新を行わない
    Application.ScreenUpdating = False
    'Sheet1を選択
    Set sheet = ThisWorkbook.Sheets(1)
    'Sheet1をアクティブ
    sheet.Activate
    'A列データの最終行取得
    Dim dataEndRow As Long
    dataEndRow = Cells(Rows.Count, 1).End(xlUp).Row
    'セルの行と列の番号を取得
    Dim cellRowAddr As Long
    Dim cellColumnAddr As Long
    'A2セルを指定
    cellRowAddr = 2
    cellColumnAddr = 1
    'ループのインデックスを指定
    Dim idx1 As Long
    '日付の値
    Dim dateValue As String
    '日付の値からymdを取得
    Dim dateValueYmd As String
    '日付の値からymdを取得(キーブレイク用)
    Dim dateValueYmd2 As String
    dateValueYmd2 = "00000000"
    'アクセス回数のカウント
    Dim accessCnt
    'キーと値を設定するDictionaryを設定
    Dim dictionary   As Scripting.dictionary
    Set dictionary = New Scripting.dictionary
    '出力時の開始のインデックス値
    Dim idxOutStart As Long
    idxOutStart = 2
    '結果欄の開始のインデックス値
    Dim resultOutIdx As Long
    resultOutIdx = 2
    'A列の日付をデータの最終行まで繰り返し取得する
    For idx1 = cellRowAddr To dataEndRow + 1
        'セルから日付を取得
        dateValue = sheet.Cells(idx1, cellColumnAddr)
        '日付からYmdを取得
        dateValueYmd = Left(dateValue, 10)
        'キーブレイク処理
        '日付が同じ場合
        If dateValueYmd = dateValueYmd2 Or dateValueYmd2 = "00000000" Then
            '辞書登録されていない場合
            If dictionary.Exists(dateValue) = False Then
                'アクセスカウントを1に設定
                accessCnt = 1
            '辞書登録されている場合
            Else
                '辞書登録したアクセスカウントの値を取得
                accessCnt = dictionary.Item(dateValue)
                'アクセスカウントを１プラスする
                accessCnt = accessCnt + 1
                '一旦、dictionaryのキーと値を削除
                Call dictionary.Remove(dateValue)
            End If
            'キーと値を辞書登録する
            Call dictionary.Add(dateValue, accessCnt)
        '日付が違う場合
        Else
            '出力処理を開始
            Dim idxOut1 As Long
            '現在のIndex値を取得
            idxOut1 = idx1
            idxOut1 = idxOut1 - 1
            '日ごとで一番アクセスカウント一番大きい日付を取得し、日付とカウントをExelの結果欄に出力
            Dim outCnt As Long
            '出力のキー(日付)
            Dim outKeyValue As String
            '出力のアクセスカウント（最高回数）
            Dim outAccessCnt As Long
            '出力のアクセスカウントTmp
            Dim outAccessCntTmp As Long
            outAccessCntTmp = 0
            '結果欄セル出力する日付キー
            Dim resultDateKey As String
            '結果欄セル出力するアクセスカウント
            Dim resultDateAccessCnt As String
            For outCnt = idxOutStart To idxOut1
                'セルから出力のキー(日付)を取得
                outKeyValue = sheet.Cells(outCnt, cellColumnAddr)
                'キーから辞書登録したアクセスカウントの値を取得
                outAccessCnt = dictionary.Item(outKeyValue)
                '取得したアクセスカウントがTmpより大きい場合は、セルに出力する値を更新
                If outAccessCnt > outAccessCntTmp Then
                    '取得したアクセスカウントをTmpに設定
                    outAccessCntTmp = outAccessCnt
                    'セルに出力する日付とアクセスか値を設定
                    resultDateKey = Left(outKeyValue, 10)
                    resultDateAccessCnt = Str(outAccessCntTmp) & "回"
                End If
            Next outCnt
            '結果欄(E列、F列)に出力
            Cells(resultOutIdx, 5) = resultDateKey
            Cells(resultOutIdx, 6) = resultDateAccessCnt
            '次の出力の時の開始位置を設定
            idxOutStart = idxOut1 + 1
            '次の結果の時の開始位置を設定
            resultOutIdx = resultOutIdx + 1
            '次のキーの初回登録
            '辞書登録されていない場合
            dictionary.RemoveAll
            If dictionary.Exists(dateValue) = False Then
                'アクセスカウントを1に設定
                accessCnt = 1
            End If
            'キーと値を辞書登録する
            Call dictionary.Add(dateValue, accessCnt)
        End If
        '日付からYmdを取得(キーブレイク用)
        dateValueYmd2 = Left(dateValue, 10)
    Next idx1
    '画面の更新を行う
    Application.ScreenUpdating = True
    MsgBox "処理を終了します。"
End Sub

3. ついでにVBAのDictionaryオブジェクトの使い方サンプル

Sub dic()

    Dim dictionary   As Scripting.dictionary
    Set dictionary = New Scripting.dictionary
    Dim dateValue As String
    Dim accessCnt As Long
    
    dateValue = "2020/09/07H14:16"
    accessCnt = 1
    Call dictionary.Add(dateValue, accessCnt)
    dateValue = "2020/09/07H14:18"
    accessCnt = 2
    Call dictionary.Add(dateValue, accessCnt)
    dateValue = "2020/09/07H14:19"
    accessCnt = 1
    Call dictionary.Add(dateValue, accessCnt)
    dateValue = "2020/09/07H14:20"
    accessCnt = 2
    Call dictionary.Add(dateValue, accessCnt)
    dateValue = "2020/09/08H14:20"
    accessCnt = 2
    Call dictionary.Add(dateValue, accessCnt)
    dateValue = "2020/09/08H14:17"
    accessCnt = 1
    Call dictionary.Add(dateValue, accessCnt)
    dateValue = "2020/09/09H14:23"
    accessCnt = 2
    Call dictionary.Add(dateValue, accessCnt)
    dateValue = "2020/09/09H14:18"
    accessCnt = 1
    Call dictionary.Add(dateValue, accessCnt)
    
    'ここでDictionaryに格納されているキーと値の一覧を取得
    'dictionaryは追加した順番で表示される
    For j = 0 To dictionary.Count - 1
        MsgBox dictionary.Keys(j)
        MsgBox dictionary.Items(j)
    Next j
    
End Sub

4. 最後に

　適当にコーディングしたので、恐らくVBAの達人がソースチェックしたら、つっこみどころ満載の殺したくなるレベルの内容。10年もSEやってて、これかよみたいな。