ExcelVBAのDo Loopステートメントの実用的なプログラム｜プログラミング学習おすすめ書籍情報発信パソコン初心者エンジニア希望者新人エンジニア IT業界への就職・転職希望者サポートサイト Programming learning Recommended schools Recommended books Information dissemination Computer beginners Prospective engineers New engineers Prospective job seekers in the IT industry Support site

目標
Do～Loopステートメントの利用
- Do～Loopステートメントを使ったおもちゃプログラム
- Do～Loopステートメントを使った実用的なプログラム
ブックマークのすすめ

目標

Do Loop ステートメントを事務処のを効率化に利用できる

Do～Loopステートメントの利用

Do～Loopステートメントを使ったおもちゃプログラム

実際の利用としてはあまり考えづらいですが、百葉箱のようなものを作成してみます。今では、GoogleのFormsなどでもっと簡単に作成できるので一先ず、こちらはアイデアよりも利用の練習としてサンプルプロシージャをあげています。

サンプルプロシージャ１

Sub DoLoop5()
Dim YNC As Integer
Dim Ans As String

Sheets("Sheet6").Select
Range("A1048576").Select
ActiveCell.End(xlUp).Select
ActiveCell.Offset(1, 0).Select

    YNC = MsgBox("要望記入シートを記入しますか？", vbYesNo)
    
    Do While YNC = vbYes
        Ans = InputBox("会社への要望を入力してください。" & Chr(10) _
                        & "終了する時は空欄のままOKを押してください。")
        If Ans = "" Then
            Exit Do
        End If
        With ActiveCell
            .Value = Ans
            .EntireColumn.AutoFit   '文字数によってセルの幅を自動調整します。「.WrapText = True」にするとセルからあふれた文字を改行してセルに収めます。
            .Interior.Color = RGB(0, 0, 0)
            .Offset(1).Select
        End With
    Loop
End Sub

実行結果

Do～Loopステートメントを使った実用的なプログラム

ここでは従業員の勤務データから給与明細の作成を行うプロシージャを組んでみたいと思います。まずはExcelシートの準備を行います。

Excelシートの準備

左に勤務データをおいて、右に給与明細のひな型を準備します。

勤務時間の入力や所得税の入力は今回は設定していません。こちらはVBAよりもエクセルのワークシート関数を利用する方が簡単に行えます。機会があれば取り上げていこうと思います。

サンプルプロシージャ２

サンプルプロシージャ２では出勤をした（勤務時間や夜間時間 > 0）の従業員の明細を作成して印刷を行うといった内容です。また月の途中で勤務時間＋夜間時間が160時間を超える従業員の名前にはFor Eachステートメントを利用してセルを緑色にハイライトしています。

ここでは「印刷」のプログラムは組んでいません。メッセージボックスが表示される部分に印刷のプログラムを記述することで印刷が可能になります。

Sub makeSalary()

Dim i As Integer, j As Integer
Dim rowNum As Integer

Sheets("Sheet5").Select
Range("A1").Select
ActiveCell.CurrentRegion.Select

rowNum = Selection.Rows.Count

i = 2
Do While i <= rowNum
    Range("L1").Value = Cells(i, 1).Value
    Range("L4").Value = Cells(i, 3).Value * (Cells(i, 6).Value - Cells(i, 8).Value)
    Range("M4").Value = Cells(i, 4).Value * (Cells(i, 7).Value - Cells(i, 9).Value)
    
    If Cells(i, 6).Value + Cells(i, 7).Value > 0 Then
    Range("K1:Q8").Select
    MsgBox "例えばここで印刷のプログラムを走らせます。"
    End If
    i = i + 1
Loop

Dim employeeName As Range
Range(Cells(2, 1), Cells(rowNum, 1)).Select

j = 2

For Each employeeName In Selection
    If Cells(j, 6).Value + Cells(j, 7).Value >= 160 Then
        Cells(j, 1).Interior.ThemeColor = xlThemeColorAccent6
    Else
        Cells(j, 1).Interior.Color = RGB(255, 255, 255)
    End If
    j = j + 1
Next employeeName

End Sub