More than 5 years have passed since last update.

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

Posted at 2019-11-24

#はじめに
AtCoder に登録したら次にやること～これだけ解けば十分闘える！過去問精選 10 問～にて紹介されていた問題をVBAで解いてみました。

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

#第1問:ABC 086 A - Product

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

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

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

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

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

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

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

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

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

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で解いてみた
 AtCoder に登録したら次にやること～これだけ解けば十分闘える！過去問精選 10 問～
AtCoder に登録したら解くべき精選過去問 10 問を VB.Net で解いてみた

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up