AtCoderに登録したら解くべき精選過去問10を VBA で解いてみた

#はじめに
[AtCoder に登録したら次にやること ～ これだけ解けば十分闘える！過去問精選 10 問 ～](https://qiita.com/drken/items/fd4e5e3630d0f5859067)にて紹介されていた問題をVBAで解いてみました。

#入力方法など
まず、A列の書式を文字列に設定します。
次に、AtCoder問題ページの入力例の横にある**Copy**をクリックし、ExcelのセルA1に貼り付けます。
最後にVBAを実行し、入力したセルの一つ下に解答を出力します。
ここでは、シート上にボタンCommandButton1を配置しシートモジュールにコードを書くものとします。
TLEや桁あふれは考慮しておりませんので、悪しからず。

#第1問:[ABC 086 A - Product](https://atcoder.jp/contests/abc086/tasks/abc086_a)
```VB:ABC086A.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim a As Integer, b As Integer
    Dim var As Variant
    
    var = Split(Range("A1").Value, " ")
    a = var(0)
    b = var(1)
    
    If a * b Mod 2 = 0 Then
        Cells(Rows.Count, 1).End(xlUp).Offset(1) = "Even"
    Else
        Cells(Rows.Count, 1).End(xlUp).Offset(1) = "Odd"
    End If
End Sub
```

+ Split関数で整数を受け取ります
+ End(xlUp)はExcel特有の出力位置の設定方法になります

#第2問:[ABC 081 A - Placing Marbles](https://atcoder.jp/contests/abc081/tasks/abc081_a)
```VB:ABC081A.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim S As String
        
    S = Range("A1").Value
    
    Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = Len(Replace(S, "0", ""))
End Sub
```

+ Replace関数で"0"を取り除きます
+ Len関数で文字数を出力します

#第3問:[ABC 081 B - Shift Only](https://atcoder.jp/contests/abc081/tasks/abc081_b)
```VB:ABC081B.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim N As Integer
    Dim A As Variant
        
    N = Range("A1").Value
    A = Split(Range("A2").Value, " ")
    
    Dim ans As Integer
    Dim i As Integer
    Do
        For i = 0 To N - 1
            If A(i) Mod 2 > 0 Then
                Exit Do
            End If
        Next
        ans = ans + 1
        For i = 0 To N - 1
            A(i) = A(i) / 2
        Next
    Loop
    
    Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = ans
End Sub
```

+ Doループ、Forループで配列を回します
+ 2で割り切れなくなった際、Exitでループを抜けます

#第4問:[ABC 087 B - Coins](https://atcoder.jp/contests/abc087/tasks/abc087_b)
```VB:ABC087B.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim A As Integer
    Dim B As Integer
    Dim C As Integer
    Dim X As Integer
        
    A = Range("A1").Value
    B = Range("A2").Value
    C = Range("A3").Value
    X = Range("A4").Value
    
    Dim ans As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    
    For i = 0 To A
        For j = 0 To B
            For k = 0 To C
                If i * 500 + j * 100 + k * 50 = X Then
                    ans = ans + 1
                End If
            Next
        Next
    Next
    
    Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = ans
End Sub
```

+ Forループを3重に回します

#第5問:[ABC 083 B - Some Sums](https://atcoder.jp/contests/abc083/tasks/abc083_b)
```VB:ABC083B.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim var As Variant
    
    var = Split(Range("A1").Value, " ")
    
    Dim N As Integer
    Dim A As Integer
    Dim B As Integer
    N = var(0)
    A = var(1)
    B = var(2)
    
    Dim ans As Integer
    Dim i As Integer
    Dim j As Integer
    Dim digSum As Integer
    For i = 1 To N
        j = i
        digSum = 0
        Do While (j > 0)
            digSum = digSum + j Mod 10
            j = j \ 10
        Loop
        If digSum >= A And digSum <= B Then
            ans = ans + i
        End If
    Next
    
    Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = ans
End Sub
```

+ 余りはMod、商は￥(円マーク)にて計算を行います
+ VBAは仕様が古いので、ショートサーキット(AndAlsoや&&)が未実装となります

#第6問:[ABC 088 B - Card Game for Two](https://atcoder.jp/contests/abc088/tasks/abc088_b)
```VB:ABC088B.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim N As Integer
    Dim a As Variant
    
    N = Range("A1").Value
    a = Split(Range("A2").Value, " ")
    
    Dim i As Integer
    For i = 1 To N
        Cells(i, 2).Value = a(i - 1)
    Next
    Range(Cells(1, 2), Cells(N, 2)).Sort key1:=Range("B1"), _
                                    order1:=xlDescending, _
                                    Header:=xlNo
    For i = 1 To N
        a(i - 1) = Cells(i, 2).Value
        Cells(i, 2).Clear
    Next
    
    Dim Alice As Integer
    Dim Bob As Integer
    For i = 0 To N - 1
        If i Mod 2 = 0 Then
            Alice = Alice + a(i)
        Else
            Bob = Bob + a(i)
        End If
    Next
    
    Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = Alice - Bob
End Sub
```

+ Sort部分を実装してもいいのですが、天下の宝刀Sortメソッドを使用します
+ このSortメソッドは、セルの値・セルの色・フォントの色などに対応した高機能なソートです

#第7問:[ABC 085 B - Kagami Mochi](https://atcoder.jp/contests/abc085/tasks/abc085_b)
```VB:ABC085B.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim N As Integer
    
    N = Range("A1").Value
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    
    Dim i As Integer
    For i = 1 To N
        If Not d.exists(Cells(i + 1, 1).Value) Then
            d.Add Cells(i + 1, 1).Value, 0
        End If
    Next
        
    Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = d.Count
End Sub
```

+ 重複を除く連想配列、VBAにもあります

#第8問:[ABC 085 C - Otoshidama](https://atcoder.jp/contests/abc085/tasks/abc085_c)
```VB:ABC085C.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim var As Variant
    var = Split(Range("A1").Value, " ")
    
    Dim N As Integer
    Dim Y As Long
    N = var(0)
    Y = var(1) / 1000
    
    
    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim f As Boolean
    For a = 0 To N
        For b = 0 To N - a
            c = N - a - b
            If a * 10 + b * 5 + c = Y Then
                f = True
                GoTo ForEnd
            End If
        Next
    Next
ForEnd:
    If f Then
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = a & " " & b & " " & c
    Else
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "-1 -1 -1"
    End If
End Sub
```

+ VBAは仕様が古いので、intの最大値は32,767、longの最大値は2,147,483,647となります
+ Gotoも使用を限定するのならばよし、と思われます

#第9問:[ABC 049 C - Daydream](https://atcoder.jp/contests/abc049/tasks/arc065_a)
```VB:ABC049C.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim S As String
    S = Range("A1").Value
    
    Dim u(0 To 3) As String
    u(0) = "dream"
    u(1) = "dreamer"
    u(2) = "erase"
    u(3) = "eraser"
    
    Dim i As Integer
    Dim f As Boolean
    Dim b As Boolean
    Do Until (b)
        b = True
        For i = 0 To 3
            If Right(S, Len(u(i))) = u(i) Then
                S = Left(S, Len(S) - Len(u(i)))
                If Len(S) = 0 Then
                    f = True
                    Exit Do
                Else
                    b = False
                    Exit For
                End If
            End If
        Next
    Loop
    If f Then
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "Yes"
    Else
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "No"
    End If
End Sub
```

+ Leftで左からの文字列の切り出し、Rightで右からの文字列の切り出しとなります

#第10問:[ABC 086 C - Traveling](https://atcoder.jp/contests/abc086/tasks/arc089_a)
```VB:ABC086C.vb
Option Explicit

Private Sub CommandButton1_Click()
    Dim N As Long
    N = Range("A1").Value
    
    Dim preX As Long
    Dim preY As Long
    Dim preT As Long
    Dim postX As Long
    Dim postY As Long
    Dim postT As Long
    
    Dim i As Long
    Dim f As Boolean
    For i = 1 To N
        Dim var As Variant
        var = Split(Cells(i + 1, 1).Value, " ")
        postT = var(0)
        postX = var(1)
        postY = var(2)
        
        Dim dt As Long
        dt = postT - preT
        Dim dist As Long
        dist = Abs(postX - preX) + Abs(postY - preY)
        If dt < dist Or Not (dist - dt) Mod 2 = 0 Then
            f = True
            Exit For
        End If
        
        preT = postT
        preX = postX
        preY = postY
    Next
    
    If f Then
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "No"
    Else
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "Yes"
    End If
End Sub
```

+ ABS関数で絶対値を求めます
+ プログラム的に難しいところはないと思われます
+ If文のアイデアが浮かぶかどうかと思われます

#おわりに
AtCoderに登録したら解くべき精選過去問10を VBA で解いてみて、VBAの仕様の古さはあるものの、それ以上にアルゴリズム能力が問われる AtCoder 問題、と感じました。

参照したサイト
[AtCoderに登録したら解くべき精選過去問10をJavaで解いてみた](https://qiita.com/0x841/items/0ce887c86cf081312a08#_reference-97c7d0ae8f053253d35b)
[AtCoder に登録したら次にやること ～ これだけ解けば十分闘える！過去問精選 10 問 ～](https://qiita.com/drken/items/fd4e5e3630d0f5859067)
[AtCoder に登録したら解くべき精選過去問 10 問を VB.Net で解いてみた](https://qiita.com/cielavenir/items/7ddf5e9bac02daf72159)