VBA 重複項目チェックツール作成(一)

 

Private Sub btnKouMoKuCheck_Click()
Dim pRow As Integer
Dim afName, lgNameStart, lgName As String

Dim i As Integer
Dim j As Integer

'ActionFrom項目一覧最終行を取得
pRow = 1
afName = "ActionFrom項目一覧"
Do While True
    With Worksheets(afName).Cells(pRow, 1)
    If .Value = "" Then
        Exit Do
    Else
        pRow = pRow + 1
    End If
    End With
Loop

For i = 1 To pRow
    lgNameStart = Worksheets(afName).Cells(i, 2)
    For j = i + 1 To pRow
        lgName = Worksheets(afName).Cells(j, 2)
       
        '重複項目がある
        If lgNameStart = lgName Then
            MsgBox afName & ":" & i & "の" & lgNameStart & "と" & j & "重複しています、直してください。"
            Exit Sub
        Else
        '重複項目がない
            j = j + 1
        End If
    Next

    i = i + 1
Next

MsgBox "重複項目がありません、チェック正常終了"
End Sub