Excel VBA 別解集 分岐処理 繰り返し処理 part3

問題

問題：B2セル～B7セルの内容によって、90以上ならA、80以上ならB、70以上ならCそれ以外ならDを表す評点をD2～D7セルに表示すること

１）Do　While文とIF文によって実現せよ。

２）配列とDo　While文、Select　Case文によって実現せよ。

３）配列とDo　Until文、IF文によって実現せよ。

４）配列とDo　Until文、Functionプロシージャを使って実現せよ。

５）配列とサブルーチンを使って実現せよ。

６）specialcellsを使って最終列をとり、Do　Until文とサブルーチンを使って実現せよ。

７）CurrentRegionとDo　Until文を用い、サブルーチンを使って実現せよ。

８）７）のサブルーチンとUBoundとFor　Next文を使って実現せよ。

９）CurrentRegionとFor　each文を用い、Functionプロシージャを使って実現せよ。

解答

１）

Sub main3()
    Dim i As Integer
    
    i = 1
    Do While Cells(i + 1, 2) <> ""
        If Cells(i + 1, 2) >= 90 Then
            Cells(i + 1, 4) = "A"
        ElseIf Cells(i + 1, 2) >= 80 Then
            Cells(i + 1, 4) = "B"
        ElseIf Cells(i + 1, 2) >= 70 Then
            Cells(i + 1, 4) = "C"
        Else
            Cells(i + 1, 4) = "D"
        End If
        i = i + 1
    Loop
End Sub

これが一番オーソドックスなやり方である。IF文が見づらければSelectCase文を用いても構わない。

２）

Sub main1()
    Dim myarry(6) As Integer
    Dim i As Integer
    
    For i = 1 To 6
        myarry(i) = Cells(i + 1, 2).Value
    Next i
    
    i = 1
    Do While Cells(i + 1, 2) <> ""
        Select Case Cells(i + 1, 2)
            Case Is >= 90
                Cells(i + 1, 4) = "A"
            Case Is >= 80
                Cells(i + 1, 4) = "B"
            Case Is >= 70
                Cells(i + 1, 4) = "C"
            Case Else
                Cells(i + 1, 4) = "D"
        End Select
        
        i = i + 1
        
    Loop
End Sub

カウンター変数ｉをとるのがポイントである。

３）

Sub main2()
    Dim myarry(6) As Integer
    Dim i As Integer
    
    For i = 1 To 6
        myarry(i) = Cells(i + 1, 2).Value
    Next i

    i = 1
    Do Until Cells(i + 1, 2) = ""
        If myarry(i) >= 90 Then
            Cells(i + 1, 4) = "A"
        ElseIf myarry(i) >= 80 Then
            Cells(i + 1, 4) = "B"
        ElseIf myarry(i) >= 70 Then
            Cells(i + 1, 4) = "C"
        Else
            Cells(i + 1, 4) = "D"
        End If
        
        i = i + 1
        
    Loop
End Sub

特別な処理は何も行っていない。素直な解法である。

４）

Sub main4()
    Dim myarry(6) As Integer
    Dim i As Integer
    
    For i = 1 To 6
        myarry(i) = Cells(i + 1, 2).Value
    Next i

    i = 1
    Do Until Cells(i + 1, 2) = ""
        Cells(i + 1, 4) = getScoredt(myarry(), i)
        i = i + 1
    Loop
End Sub
Function getScoredt(myarry() As Integer, i As Integer) As String

    Select Case myarry(i)
        Case Is >= 90
            getScoredt = "A"
        Case Is >= 80
            getScoredt = "B"
        Case Is >= 70
            getScoredt = "C"
        Case Else
            getScoredt = "D"
    End Select
End Function

Functionプロシージャを使うと、メインの文が簡潔になり、保守しやすいという利点がある。

５）

Sub main5()
    Dim myarry(6) As Integer
    Dim i As Integer
    
    For i = 1 To 6
        myarry(i) = Cells(i + 1, 2).Value
    Next i

    Call getScore(myarry(6))
End Sub
Sub getScore(myarry As Integer)
    Dim i As Integer
    
    For i = 2 To 7
        If Cells(i, 2) >= 90 Then
            Cells(i, 4) = "A"
        ElseIf Cells(i, 2) >= 80 Then
            Cells(i, 4) = "B"
        ElseIf Cells(i, 2) >= 70 Then
            Cells(i, 4) = "C"
        Else
            Cells(i, 4) = "D"
        End If
    Next i
End Sub

引数でmyarryを取ったが、使わなかった例である。

６）

Sub main6()
    Dim lcr As Integer, i As Integer
    
    lcr = Range("B2").CurrentRegion.SpecialCells(xlCellTypeLastCell).Row

    i = 1
    Do Until Cells(i + 1, 2) = ""
        Call getScoreList(lcr, i)
        i = i + 1
    Loop
End Sub
Sub getScoreList(lcr As Integer, i As Integer)
    For i = 1 To lcr - 1
        If Cells(i + 1, 2) >= 90 Then
            Cells(i + 1, 4) = "A"
        ElseIf Cells(i + 1, 2) >= 80 Then
            Cells(i + 1, 4) = "B"
        ElseIf Cells(i + 1, 2) >= 70 Then
            Cells(i + 1, 4) = "C"
        Else
            Cells(i + 1, 4) = "D"
        End If
    Next i
    
End Sub

CurrentRegionのspecialcellsを使った例である。xlCellTypeLastCellの他に、xlcelltypeconstantsb(定数を表す),xlcelltypefomulas(数式のセル),xlcelltypelastcell(最後のセル)がある。

７）

Sub main7()
    Dim myarry As Variant
    Dim i As Integer
    
    myarry = Range("A1").CurrentRegion
    
    i = 2
    Do Until Cells(i, 2) = ""
        Cells(i, 4) = getScore1(myarry, i)
        i = i + 1
    Loop
End Sub
Function getScore1(myarry As Variant, i As Integer) As String
    If myarry(i, 2) >= 90 Then
        getScore1 = "A"
    ElseIf myarry(i, 2) >= 80 Then
        getScore1 = "B"
    ElseIf myarry(i, 2) >= 70 Then
        getScore1 = "C"
    Else
        getScore1 = "D"
    End If
End Function

Variant型を使って、一発で表を取り込んだ例である。

８）

Sub main8()
    Dim myarry As Variant
    Dim i As Integer
    
    myarry = Range("A1").CurrentRegion

    For i = 2 To UBound(myarry)
        Cells(i, 4) = getScore1(myarry, i)
    Next i
End Sub

Function getScore1(myarry As Variant, i As Integer) As String
    If myarry(i, 2) >= 90 Then
        getScore1 = "A"
    ElseIf myarry(i, 2) >= 80 Then
        getScore1 = "B"
    ElseIf myarry(i, 2) >= 70 Then
        getScore1 = "C"
    Else
        getScore1 = "D"
    End If
End Function

配列にUBoundを使って最終列を取った例である。

９）

Sub main9()
    Dim myrng As Range
    Dim i As Integer, lcr As Integer
    
    lcr = Range("A2").CurrentRegion.Rows.Count
    
    i = 2
    For Each myrng In Range(Cells(2, 2), Cells(lcr, 2))
        Range("D" & i) = getScore2(myrng, i)
        i = i + 1
    Next myrng
End Sub
Function getScore2(myrng As Range, i As Integer) As String
    Select Case myrng
        Case Is >= 90
            getScore2 = "A"
        Case Is >= 80
            getScore2 = "B"
        Case Is >= 70
            getScore2 = "C"
        Case Else
            getScore2 = "D"
    End Select
End Function

CurrentRegionで最終行をとり、Foreachのオブジェクトを設定した例である。