☆エコ・RDB 〔3〕レコード番号の作成

Dim R As Long, C As Integer, C0 As Integer, D0 As Long, D1 As Long, D2 As Long, ER As Long, MxC As Integer
Dim IMax As Long, RCpo As IntegerDim SampID(), FF As String
Dim TMP As Worksheet, RDB As Worksheet

Dim TmpS As String, RdbS As String

Sub Make_RecNo_ER2()
'
' RecNo Macro
' マクロ作成日 : 2008/10/8  ユーザー名 : 寺田屋の龍馬
'
'  　レコード番号をシート１に作成

'　　Ｅｃｏ_ＲＤＢ【エコ・ＲＤＢ】 Ver．２.０

    TmpS = "Sheet1": RdbS = "Sheet2"

    Set TMP = Worksheets(TmpS)    Set RDB = Worksheets(RdbS)

    MsgBox "レコード番号作成スタート！ "

    TMP.Range("AH1:CS60000").ClearContents

 ST$ = Time$

    IMax = RDB.Cells(3, 201) '対象レコード数    RCpo = RDB.Cells(4, 201)

 MxC = (IMax - 1) \ 60000 + 1: FF = String(16, Chr(-1))

 D0 = 0: D1 = 1: D2 = 0: C0 = 34 SampID() = TMP.Range(TMP.Cells(1, C0 + 1), TMP.Cells(60000, C0 + MxC * 2)).Value

 For C = 1 To MxC

    For R = 1 To 60000

        D2 = D2 + 1
        D0 = D0 + 1
        SampID(R, C * 2) = D1 * 10000 + D2

        ER = R
        If D2 = RCpo Then D2 = 0: D1 = D1 + 1
        If D0 = IMax Then R = 60000

    Next

    TMP.Cells(ER + 1, C0 + C * 2 - 1) = FF

 Next

 TMP.Range(TMP.Cells(1, C0 + 1), TMP.Cells(60000, C0 + MxC * 2)).Value = SampID()

 MsgBox "処理時間..." + Chr$(13) + Chr$(13) + "開始 : " + ST$ + Chr$(13) + Chr$(13) + "終了 : " + Time$ + Chr$(13) + Chr$(13) + "作成件数 : " + CStr(D0) + " 件"

End Sub