☆エコ・RDB 〔12〕ＩＤの並びをチェック

Sub ID_Check()
'
' ID_Check Macro
' マクロ記録日 : 2008/8/27  ユーザー名 : 寺田屋の龍馬
'

'
    Dim S3 As Worksheet
    Set S3 = Worksheets("Sheet2")

    Dim Max0 As Long, Max1 As Integer, ChDat1, ChDat2, CH As Integer, C1 As Long, C2 As Long, Co As Long

    Dim R As Long, C As Integer, MxR As Integer, MxC As Integer    Dim Sp0 As Integer, Sp1 As Integer, Sp2 As Long, Rn As Long, RCpo As Long, RCpo0 As Long

    ST$ = Time$

    'Sub_ID

    RCpo0 = S3.Cells(4, 201)
    Max1 = S3.Cells(1, 202)
    Max0 = S3.Cells(2, 202)

    MxC = Max1
    ChDat2 = 0
 For C = 1 To MxC

    Call Worksheet_SelectionChange(S3.Range(S3.Range("A" + CStr(RCpo0 + C)).Formula), Rn, Sp1)

    RCpo = Rn - 1

    MxR = S3.Cells(RCpo, Sp1)

    For R = 1 To MxR

        Sp2 = RCpo + R

        C1 = S3.Cells(Sp2, Sp1)        ChDat1 = S3.Cells(C1 Mod 10000, C1 \ 10000)

        If ChDat1 > "" Then

            If ChDat1 >= ChDat2 Then

                If ChDat1 = ChDat2 Then

                    If C1 <= C2 Then
                        'マスタデータ重複の際にレコード番号が昇順でないエラー。
                        Stop
                    End If
                End If

                Co = Co +　1

                ChDat2 = ChDat1

                C2 = C1

            Else
                'マスタデータの並びが昇順でないか同じでないエラー。
                Stop

            End If

        End If

    Next

Next

    MsgBox "ＩＤチェック完了！ " + Chr$(13) + Chr$(13) + "開始 : " + ST$ + Chr$(13) + Chr$(13) + "終了 : " + Time$ + Chr$(13) + Chr$(13) + "ＩＤチェック件数 ＝" + CStr(Co) + " 件"

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range, Rn As Long, Cn As Integer)

    Rn = Target.Row

    Cn = Target.Column

End Sub