ポーカー : 第一回 オフラインリアルタイムどう書くの参考問題 http://qiita.com/items/cbc3af152ee3f50a822f

Module1.vb

Option Explicit

Sub test()
    Debug.Assert Poker("S2H2D2C2S3") = "4K"
    Debug.Assert Poker("D3C3C10D10S3") = "FH"
    Debug.Assert Poker("S2H2D2C3S4") = "3K"
    Debug.Assert Poker("S8D10HJS10CJ") = "2P"
    Debug.Assert Poker("S2H2D3C4S5") = "1P"
    Debug.Assert Poker("S2H3D4C5S6") = "--"
End Sub

Function Poker(ByVal Cards As String) As String
    Dim Reg As Object
    Dim Dic As Object
    Dim Card As Variant
    Dim Num As String
    
    ' カードとカードの間にカンマを挟む
    Set Reg = CreateObject("VBScript.RegExp")
    Reg.Pattern = "(\d+|[AJQK])\B"
    Reg.Global = True
    Cards = Reg.Replace(Cards, "$1,")

    Set Dic = CreateObject("Scripting.Dictionary")
    
    ' カードを数字でグループ化し、同じ数字をカウントする
    For Each Card In Split(Cards, ",")
        Num = Mid$(Card, 2)
        If Dic.Exists(Num) Then
            Dic(Num) = Dic(Num) + 1
        Else
            Dic(Num) = 1
        End If
    Next Card
    
    ' グループ数を手がかりに役を判断する
    Select Case Dic.Count
        Case 2
            Poker = IIf(Max(Dic.Items) = 4, "4K", "FH")
        Case 3
            Poker = IIf(Max(Dic.Items) = 3, "3K", "2P")
        Case 4
            Poker = "1P"
        Case Else
            Poker = "--"
    End Select
End Function

Function Max(ByVal Nums) As Long
    Max = WorksheetFunction.Max(Nums)
End Function