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 하고 있어, 이것일까 같다.