☆エコ・RDB 〔4〕マスタデータ＋IDの挿入

Dim R As Long, C As Integer, MxR As Long, MxC As Integer, IMax As Long, BfMx As Long
Dim InsDt As Variant, InsRn As Variant, Rn As Long, Cn As Long, Co As LongDim MxDt As Long, RCpo As Integer, BMax As Integer, BCut As Integer, TMP1()
Dim MST As Worksheet, IDX As Worksheet

Dim MstS As String, IdxS As String

Sub Ins_Dat_ER2()
'
' Ins_Dat Macro
' マクロ記録日 : 2008/10/8  ユーザー名 :寺田屋の龍馬
'
' 　　シート１のマスタデータ＋ＩＤをＲＤＢシートへ挿入

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

 ST$ = Time$

        Application.ScreenUpdating = False

    MstS = "Sheet1": IdxS = "Sheet2"

    Set MST = Worksheets(MstS)    Set IDX = Worksheets(IdxS)

    MxC = 1 'シート１の１～１７列    MxR = 1 'シート１の１～１７列の１～６００００行

    InsCo = 0: InsRn = 10001

    MxDt = IDX.Cells(2, 201): BfMx = MxDt
    IMax = IDX.Cells(3, 201)
    RCpo = IDX.Cells(4, 201)
    Cl = IDX.Cells(5, 201)
    BMax = IDX.Cells(3, 202)
    BCut = IDX.Cells(4, 202)

    TMP1() = IDX.Range(IDX.Cells(RCpo + 1, 1), IDX.Cells(RCpo + 4001, 1))

    Call Worksheet_SelectionChange(IDX.Range(IDX.Cells(5, 202)), Rn, Cn)

    If MxDt > 0 Then '空きレコード番号を取得
      Call Src_Rn_ER2 (IDX, InsRn, Rn, Cn, Co, RCpo, Cl)
    End If

    If Rn > 0 And Cn > 0 Then

        For C = 1 To MxC

            For R = 1 To MxR

                InsDt = MST.Cells(R, C) 'シート１のマスタデータを変数にセット

                'マスタデータをＲＤＢシートへ書き込み、インデックスを生成                Call Ins_Dt_ER2(IDX, IDX, InsDt, InsRn, Rn, Cn, MxDt, RCpo, BMax, BCut, TMP1())

                '空きレコード番号を予約
                Call Src_Rn_ER2 (IDX, InsRn, Rn, Cn, Co, RCpo, Cl)

            Next
        Next
    End If

 If Rn > 0 And Cn > 0 Then

    IDX.Cells(5, 202) = IDX.Cells(Rn, Cn).Address(RowAbsolute:=False)

 MsgBox "ＩＤマージ完了！ " + Chr$(13) + Chr$(13) + "開始 : " + ST$ + Chr$(13) + Chr$(13) + "終了 : " + Time$ + Chr$(13) + Chr$(13) + "ＩＤマージ件数 ＝" + Str(MxDt - BfMx) + " 件"

 Else

 MsgBox "データエリアが一杯になりました！" + Chr$(13) + Chr$(13) + "開始 : " + ST$ + Chr$(13) + Chr$(13) + "終了 : " + Time$ + Chr$(13) + Chr$(13) + "ＩＤマージ件数 ＝" + Str(MxDt - BfMx) + " 件"

 End If
        Application.ScreenUpdating = True
End Sub

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

    Rn = Target.Row

    Cn = Target.Column

End Sub