Function 文字頻度(文字列 As String, Optional 順位 As Integer = 0, Optional 出力 As Integer = 0)

' 入力　文字列：対象の文字列
' 　　　順位：出力する文字の頻度順位（省略可）
' 　　　出力：　0：文字（省略可：既定）
' 　　　　　　　1：使用されている個数
' 戻り値
' 　　　順位省略時は文字種別個数
'       順位指定時
' 　　　　出力 0：指定順位の文字を返す
' 　　　　　　 1：指定順位の文字数を返す

    Dim tmp()           '作業用配列  1:文字 2:個数 3;処理済みフラグ
    Dim Ub As Integer   '配列添え字上限
    
    Dim i As Integer, k As Integer  '作業用カウンタ
    Dim flg As Boolean  '作業用フラグ
    Dim Dt As String    '作業用文字格納用
    
    ReDim tmp(3, 0)

    '重複を排除して作業用配列に格納
    
    For i = 1 To Len(文字列)
        Dt = Mid(文字列, i, 1)
        flg = False
        
        '新規判定　格納済み配列内を検索
        For k = 1 To UBound(tmp, 2)
            If Dt = tmp(1, k) Then  '有ったら
                tmp(2, k) = tmp(2, k) + 1   'カントアップ
                flg = True
                Exit For
            End If
        Next k
        If Not flg Then '無かったら新規追加
            Ub = UBound(tmp, 2) + 1
            ReDim Preserve tmp(3, Ub)
            tmp(1, Ub) = Mid(文字列, i, 1)
            tmp(2, Ub) = 1
            tmp(3, Ub) = False
        End If
    Next i
    
    '順位付け
    
    Dim TblRank()   '結果格納用配列 1:文字 2:個数
    Dim mV As Double, v As Double
    Dim idx As Integer
    Dim cnt As Integer
    
    ReDim TblRank(2, UBound(tmp, 2))
    cnt = 0
    
    Do
        flg = False
        mV = -1
        idx = -1
        For i = 1 To UBound(tmp, 2)
            If Not tmp(3, i) Then
                v = tmp(2, i) + 1 - AscW(tmp(1, i)) / 100000
                If v > mV Then
                    idx = i
                    mV = v                      '最大値更新
                    flg = True
                End If
            End If
        Next i
        If idx > 0 Then '候補あり？　（必ず有るはず！無ければバグ！）
            cnt = cnt + 1
            TblRank(1, cnt) = tmp(1, idx)
            TblRank(2, cnt) = tmp(2, idx)
            tmp(3, idx) = True
        End If
    Loop While flg
    
    '戻り値
    
    If 順位 = 0 Then
        文字頻度 = UBound(TblRank, 2)
    Else
        Select Case 出力
            Case 0: 文字頻度 = TblRank(1, 順位)
            Case 1: 文字頻度 = TblRank(2, 順位)
        End Select
    End If
    
End Function