LoginSignup
1

More than 5 years have passed since last update.

【編集中 記事】Excelで作成した試験書の入力にミスがないかを確認するマクロ

Posted at

作成の目的

試験書への入力ミスを自動チェックする

チェックする試験書は以下

試験書サンプル.PNG

試験書ルール

実施可否 列ルール

・「否」の場合 → その行に値が一切入っていないことを確認する
・「要」の場合 → ステータス列のセルを判定する (○: 入力されていること ×: 入力されていないこと)
・OK →【実施者】○|【実施日時】○|【実施環境】○|【Bug#】×|【Block#】×|【備考】○
・NG →【実施者】○|【実施日時】○|【実施環境】○|【Bug#】○|【Block#】×|【備考】○
・PEND →【実施者】○|【実施日時】○|【実施環境】×|【Bug#】×|【Block#】×|【備考】○
・BLOCK→【実施者】○|【実施日時】×|【実施環境】×|【Bug#】×|【Block#】○|【備考】○
・N/T →ステータスの列にN/Tがないことを確認する

コード

Sub CheckTestCase()

'試験書を指定するファイルダイアログ表示
'指定した試験書のオブジェクト変数へ格納
Dim TargetBook As String
TargetBook = Application.GetOpenFilename("Excel ブック,*.xls?")
If TargetBook = "False" Then Exit Sub
Workbooks.Open TargetBook

'=====================
'Debug→TargetBook
Debug.Print "TargetBookは【" & TargetBook & "】" '指定したファイル名までのPATHが表示される


'その試験書の全シートに対して実行していく
Dim NumOfSheets As Long
Dim NameOfSheet As String
Dim DoYouExecute As String
Dim LastRow As Long
Dim i As Long
Dim j As Long
Dim k As Long

NumOfSheets = ActiveWorkbook.Worksheets.Count

'=====================
'Debug→NumOfSheets
Debug.Print NumOfSheets '5 存在するシート数 表示

For i = 1 To NumOfSheets
L1:

If i > NumOfSheets Then
    Exit For
End If

Worksheets(i).Activate

LastRow = Cells(Rows.Count, 2).End(xlUp).Row
Debug.Print "最終行は " & LastRow & "です"

'シートが切り替わるタイミングで実施有無を確認させるダイアログを表示する

NameOfSheet = ActiveSheet.Name

'=====================
'Debug→NameOfSheet
Debug.Print NameOfSheet


DoYouExecute = MsgBox("【" & NameOfSheet & "】" & "の試験書チェックを" & vbCrLf & _
"実行しますか?", vbYesNo)

    '「いいえ」の場合→次のシートへループ
    If DoYouExecute = vbNo Then
        i = i + 1
        GoTo L1

    ElseIf DoYouExecute = vbYes Then
    '「はい」の場合→そのシート内で試験書チェック処理実行
        '実施可否の列をループする
            '「否」→その行に値が一切入っていないことを確認する
            For j = 3 To LastRow
                If Cells(j, 9).Value = "否" Then
                    For k = 10 To 16
                        If Cells(j, k).Value <> "" Then
                            Cells(j, k).Interior.ColorIndex = 46
                        End If
                    Next k

            '「要」→ステータス列のセルを判定する
                ElseIf Cells(j, 9).Value = "要" Then

                    'OK   →【実施者】○|【実施日時】○|【実施環境】○|【Bug#】×|【Block#】×|【備考】○
                    If Cells(j, 13).Value = "OK" Then
                        If Cells(j, 10).Value = "" Then
                            Cells(j, 10).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 11).Value = "" Then
                            Cells(j, 11).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 12).Value = "" Then
                            Cells(j, 12).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 14).Value <> "" Then
                            Cells(j, 14).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 15).Value <> "" Then
                            Cells(j, 15).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 16).Value = "" Then
                            Cells(j, 16).Interior.ColorIndex = 46
                        End If


                    'NG   →【実施者】○|【実施日時】○|【実施環境】○|【Bug#】○|【Block#】×|【備考】○
                    ElseIf Cells(j, 13).Value = "NG" Then
                        If Cells(j, 10).Value = "" Then
                            Cells(j, 10).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 11).Value = "" Then
                            Cells(j, 11).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 12).Value = "" Then
                            Cells(j, 12).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 14).Value = "" Then
                            Cells(j, 14).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 15).Value <> "" Then
                            Cells(j, 15).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 16).Value = "" Then
                            Cells(j, 16).Interior.ColorIndex = 46
                        End If

                    'PEND →【実施者】○|【実施日時】○|【実施環境】×|【Bug#】×|【Block#】×|【備考】○
                    ElseIf Cells(j, 13).Value = "PEND" Then
                        If Cells(j, 10).Value = "" Then
                            Cells(j, 10).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 11).Value = "" Then
                            Cells(j, 11).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 12).Value <> "" Then
                            Cells(j, 12).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 14).Value <> "" Then
                            Cells(j, 14).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 15).Value <> "" Then
                            Cells(j, 15).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 16).Value = "" Then
                            Cells(j, 16).Interior.ColorIndex = 46
                        End If

                    'BLOCK→【実施者】○|【実施日時】×|【実施環境】×|【Bug#】×|【Block#】○|【備考】○
                    ElseIf Cells(j, 13).Value = "BLOCK" Then
                        If Cells(j, 10).Value = "" Then
                            Cells(j, 10).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 11).Value <> "" Then
                            Cells(j, 11).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 12).Value <> "" Then
                            Cells(j, 12).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 14).Value <> "" Then
                            Cells(j, 14).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 15).Value = "" Then
                            Cells(j, 15).Interior.ColorIndex = 46
                        End If
                        If Cells(j, 16).Value = "" Then
                            Cells(j, 16).Interior.ColorIndex = 46
                        End If

                    'N/T  →ステータスの列にN/Tがないことを確認する
                    ElseIf Cells(j, 13).Value = "N/T" Then
                        Cells(j, 13).Interior.ColorIndex = 46

                    End If
                End If
             Next j
        End If
Next i

End Sub

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1