のんびり座りたい ～ 横へな 2013.2.2 http://nabetani.sakura.ne.jp/hena/ord7selectchair/

Module1.vb

Option Explicit

Private Reg As Object
#Const ONE_LINER = 0

Sub test()
    Debug.Assert Seats("6:NABEbBZn") = "-ZAB-E"
    Debug.Assert Seats("1:A") = "A"
    Debug.Assert Seats("1:Aa") = "-"
    Debug.Assert Seats("2:AB") = "AB"
    Debug.Assert Seats("2:AaB") = "B-"
    Debug.Assert Seats("2:AZa") = "-Z"
    Debug.Assert Seats("2:AZz") = "A-"
    Debug.Assert Seats("3:ABC") = "ACB"
    Debug.Assert Seats("3:ABCa") = "-CB"
    Debug.Assert Seats("4:ABCD") = "ADBC"
    Debug.Assert Seats("4:ABCbBD") = "ABDC"
    Debug.Assert Seats("4:ABCDabcA") = "-D-A"
    Debug.Assert Seats("5:NEXUS") = "NUESX"
    Debug.Assert Seats("5:ZYQMyqY") = "ZM-Y-"
    Debug.Assert Seats("5:ABCDbdXYc") = "AYX--"
    Debug.Assert Seats("6:FUTSAL") = "FAULTS"
    Debug.Assert Seats("6:ABCDEbcBC") = "AECB-D"
    Debug.Assert Seats("7:FMTOWNS") = "FWMNTSO"
    Debug.Assert Seats("7:ABCDEFGabcdfXYZ") = "YE-X-GZ"
    Debug.Assert Seats("10:ABCDEFGHIJ") = "AGBHCIDJEF"
End Sub

Function Seats(ByVal Order As String) As String
    Dim Result As String
    Dim Temp As Variant
    Dim SeatsCount As Long
    Dim Line As String
    Dim One As String
    Dim n As Long
    Dim i As Long
    
    Temp = Split(Order, ":")
    SeatsCount = CLng(Temp(0))
    Line = Temp(1)
    Result = String(SeatsCount, "-")
    Set Reg = CreateObject("VBScript.RegExp")
    
    n = Len(Line)
    For i = 1 To n
        One = Mid$(Line, i, 1)
        If IsUpper(One) Then
            Result = SitDown(One, Result)
        Else
            Result = Leave(One, Result)
        End If
    Next i
    
    Seats = Result
End Function

Function IsUpper(ByVal c As String) As Boolean
    IsUpper = c Like "[A-Z]"
End Function

#If ONE_LINER Then
    Function SitDown(ByVal One As String, ByVal Seats As String) As String
        ' 人が座る席は以下のルールで決まる:
        
        ' 1. どちら側の隣にも人が座っていない席を選ぶ｡
        ' ^(.*?)(?:\B-\B)(.*)$
        
        ' 2. それが無理なら､片側にしか人が座っていない席を選ぶ｡
        ' ^(.*?)(?:\b-\B|\B-\b)(.*)$
        
        ' 3. それも無理なら､両側に人が座っている席を選ぶ｡
        ' ^(.*?)(?:-)(.*)$
        
        ' 4. 上記の条件で一つに決まらない場合は､候補のうち最も左にある席を選ぶ｡
        ' 5. 一度座ったら立ち去るまでその場を動かない｡

        Reg.Pattern = _
            "^(.*?)(?:\B-\B)(.*)$|^(.*?)(?:\b-\B|\B-\b)(.*)$|^(.*?)(?:-)(.*)$"
        SitDown = Reg.Replace(Seats, "$1$3$5" & One & "$2$4$6")
    End Function
#Else
    Function SitDown(ByVal One As String, ByVal Seats As String) As String
        Dim Patterns(2) As String
        Dim i As Long
        
        ' 人が座る席は以下のルールで決まる:
        ' 1. どちら側の隣にも人が座っていない席を選ぶ｡
        Patterns(0) = "\B-\B"
        ' 2. それが無理なら､片側にしか人が座っていない席を選ぶ｡
        Patterns(1) = "\b-\B|\B-\b"
        ' 3. それも無理なら､両側に人が座っている席を選ぶ｡
        Patterns(2) = "-"
        ' 4. 上記の条件で一つに決まらない場合は､候補のうち最も左にある席を選ぶ｡
        ' 5. 一度座ったら立ち去るまでその場を動かない｡
    
        For i = 0 To 2
            Reg.Pattern = Patterns(i)
            If Reg.test(Seats) Then
                SitDown = Reg.Replace(Seats, One)
                Exit For
            End If
        Next i
    End Function
#End If

Function Leave(ByVal One As String, ByVal Seats As String) As String
    Leave = Replace(Seats, StrConv(One, vbUpperCase), "-")
End Function