0

私はVbaが初めてです。誰かが私の問題を解決してくれることを願っています。スプレッドシートにあるデータを更新しようとしています。実際には 20,000 のレコードがあり、各レコードには約 74 の列があります。そのため、ADO を使用してレコードごとに更新すると、非常に時間がかかります。これらのレコードをシングル ショットで更新する別の方法はありますか。どんな助けでも大歓迎です。

現在、私のコードは.

    Sub InitialExport()
      On Error GoTo ErrHandler

    Dim con As New ADODB.Connection
    Dim Query As String
    Dim EffectedRecs As Long
    Dim i As Integer

    ServerName = "192.178.78.36"

    'Setting ConnectionString
    con.ConnectionString = "Provider=SQLOLEDB; " & _
            "Data Source=" & ServerName & "; " & _
            "Initial Catalog=AppEmp;" & _
            "User ID=sa; Password=admin08; "

    'Setting provider Name
    con.Provider = "Microsoft.JET.OLEDB.12.0"

    'Opening connection
    con.Open
    With ThisWorkbook.Sheets("Export")
    For i = 3 To ThisWorkbook.Sheets("Export").Range("B65536").End(xlUp).Row
        '---------------------->
        EmpId = .Range("B" & i).Value 'Emp Code-varchar
        C = .Range("C" & i).Value 'Emp Name-varchar
        D = .Range("D" & i).Value 
        E = .Range("E" & i).Value 
        F = .Range("F" & i).Value 
        G = .Range("G" & i).Value 
        H = .Range("H" & i).Value
        II = .Range("I" & i).Value 
        JJ = .Range("J" & i).Value 
        k = .Range("K" & i).Value 
        l = .Range("L" & i).Value 
        M = .Range("M" & i).Value 

        N = CheckNull(.Range("N" & i).Value)
        O = CheckNull(.Range("O" & i).Value) 
        P = CheckNull(.Range("P" & i).Value) 
        Q = CheckNull(.Range("Q" & i).Value) 
        R = CheckNull(.Range("R" & i).Value) 
        S = .Range("S" & i).Value 
        T = .Range("T" & i).Value 
        U = .Range("U" & i).Value 
        v = .Range("V" & i).Value 
        W = .Range("W" & i).Value
        X = CheckNull(.Range("X" & i).Value)

        Y = .Range("Y" & i).Value 
        Z = .Range("Z" & i).Value 
        AA = CheckNull(.Range("AA" & i).Value)
        AB = .Range("AB" & i).Value 
        AC = CheckNull(.Range("AC" & i).Value) 
        AD = CheckNull(.Range("AD" & i).Value) 
        AE = CheckNull(.Range("AE" & i).Value) 
        AF = CheckNull(.Range("AF" & i).Value)
        AG = .Range("AG" & i).Value 
        AH = CheckNull(.Range("AH" & i).Value) 
        AI = CheckNull(.Range("AI" & i).Value) 
        AJ = CheckNull(.Range("AJ" & i).Value) 
        AK = CheckNull(.Range("AK" & i).Value)
        AL = CheckNull(.Range("AL" & i).Value) 
        AM = CheckNull(.Range("AM" & i).Value)
        AN = CheckNull(.Range("AN" & i).Value) 
        AO = CheckNull(.Range("AO" & i).Value) 
        AP = CheckNull(.Range("AP" & i).Value) 
        AQ = CheckNull(.Range("AQ" & i).Value)
        AR = CheckNull(.Range("AR" & i).Value) 
        aAS = CheckNull(.Range("AS" & i).Value) 
        AT = .Range("AT" & i).Value
        AU = CheckNull(.Range("AU" & i).Value) 
        AV = CheckNull(.Range("AV" & i).Value) 
        AW = CheckNull(.Range("AW" & i).Value) 
        AX = CheckNull(.Range("AX" & i).Value) 
        AY = CheckNull(.Range("AY" & i).Value) 
        AZ = CheckNull(.Range("AZ" & i).Value) 
        BA = CheckNull(.Range("BA" & i).Value) 
        BB = CheckNull(.Range("BB" & i).Value)
        BC = CheckNull(.Range("BC" & i).Value) 
        BD = CheckNull(.Range("BD" & i).Value)
        BE = .Range("BE" & i).Value 

        BF = .Range("BF" & i).Value 
        BG = CheckNull(.Range("BG" & i).Value) 
        BH = .Range("BH" & i).Value 
        BI = .Range("BI" & i).Value 
        BJ = CheckNull(.Range("BJ" & i).Value) 
        BK = CheckNull(.Range("BK" & i).Value) 
        BL = CheckNull(.Range("BL" & i).Value) 
        BM = .Range("BM" & i).Value 
        BN = .Range("BN" & i).Value 



        Query = "Exec HRApp_P_AddEmpData '" & EmpId & "','" & C & "','" & D & "','" & E & "','" & F & "','" & G & "','" & H & "','" & II & "','" & JJ & "','" & k & "','" & l & "','" & M & "'," & N & "," & O & "," & P & "," & Q & "," & R & ",'" & S & "','" & T & "','" & U & "','" & v & "','" & W & "'," & X & ",'" & Y & "','" & Z & "'," & AA & ",'" & AB & "'," & AC & "," & AD & "," & AE & "," & AF & ",'" & AG & "'," & AH & "," & AI & "," & AJ & "," & AK & ",'" & AL & "'," & AM & "," & AN & "," & AO & "," & AP & "," & AQ & "," & AR & "," & aAS & ",'" & AT & "'," & AU & "," & AV & "," & AW & "," & AX & "," & AY & "," & AZ & "," & BA & "," & BB & "," & BC & "," & BD & ",'" & BE & "','" & BF & "'," & BG & ",'" & BH & "','" & BI & "'," & BJ & "," & BK & "," & BL & ",'" & BM & "','" & BN & "'"

        con.Execute Query

    Next
    End With

     con.Close
     Set con = Nothing
    Exit Sub
ErrHandler:     'MsgBox "The Not able ta Save Data"

                Set con = Nothing
End Sub

上記のコードは正常に動作しています。しかし、データの更新に時間がかかっています.:-(

今私のコードはこのようになりました

  Private Sub Worksheet_Activate()
    Dim adoConn             As New ADODB.Connection
    Dim adoRS               As New ADODB.Recordset

    Dim sQuery              As String
    Dim EffectedRecs        As Long
    Dim sFields             As String
    Dim sValues             As String

    Dim iRow                As Integer
    Dim iField              As Integer

    ServerName = "193.128.125.14"
    con_Str = "Provider=SQLOLEDB; " & _
            "Data Source=" & ServerName & "; " & _
            "Initial Catalog=DB_At&T;" & _
            "User ID=sa; Password=ad28; "

    sQuery = "select * from Currency where 1=2"

    sValues = ""

    With adoConn
        .ConnectionString = con_Str
        .Provider = "Microsoft.JET.OLEDB.12.0"
        .CursorLocation = adUseClient
        .Open
    End With

    With adoRS
        .ActiveConnection = adoConn
        .CursorLocation = adUseClient
        .LockType = adLockBatchOptimistic
        .CursorType = adOpenKeyset ' adOpenDynamic
        .Source = sQuery
        .Open
    End With

    With ThisWorkbook.Sheets("Export")
        For iRow = 3 To ThisWorkbook.Sheets("Export").Range("B65536").End(xlUp).Row
            For iField = 0 To adoRS.Fields.Count - 1
                sFields = sFields & "," & adoRS.Fields(iField).Name
            Next

            sValues = sValues & "," & .Range("A" & iRow).Value
            sValues = sValues & "," & .Range("B" & iRow).Value
            sValues = sValues & "," & .Range("C" & iRow).Value
            sValues = sValues & "," & .Range("D" & iRow).Value

            sFields = Right(sFields, Len(sFields) - 1) 'Removing ,
            sValues = Right(sValues, Len(sValues) - 1) 'Removing ,
            adoRS.AddNew FieldList = sFields, Values:=sValues
        Next
End With

    adoRS.UpdateBatch adAffectAllChapters

    adoRS.Close
    adoConn.Close
End Sub
4

2 に答える 2

1

あなたはこれを試すことができます：

Sub InitialExport()
On Error GoTo ErrHandler
'
Dim adoConn             As New ADODB.Connection
Dim adoRS               As ADODB.Recordset
'
Dim sQuery              As String
Dim EffectedRecs        As Long
Dim sFields             As String
Dim sValues             As String
'
Dim iRow                As Integer
Dim iField              As Integer
'
ServerName = SERVER_NAME
'
sQuery="SELECT * from tableName where 1 =2" ' get an empty recordset!
'
'Set the connection and open
with adoConn
    .ConnectionString = CONNECTION_STRING
    .Provider = "Microsoft.JET.OLEDB.12.0"
    .cursorlocation=aduseclient
    .Open
end with
'
' set the Recordset and open
With adoRS
    .activeconnection=adoconn
    .CursorLocation = adUseClient
    .LockType = adLockBatchOptimistic
    .CursorType = adopenkeyset ' adOpenDynamic
    .Source = sQuery
    .Open
End With
'
' now get the data into the recordset
With ThisWorkbook.Sheets("Export")
    For iRow = 3 To ThisWorkbook.Sheets("Export").Range("B65536").End(xlUp).Row
        ' here loop through all the columns
        For iField = 0 To adoRS.Fields.Count - 1
            ' adding the column names to the Variable sFields
            sFields = sFields & "," & adoRS.Fields(iField).Name
            '
            ' adding the values from the worksheet for this row
            sValues = sValues & ", " & .Cells(iRow, iField).Text
        Next
        '
        ' add a new record with the fields and values
        adoRS.AddNew FieldList:=sFields, Values:=sValues
        '
Next
'
' update all the rows in one step
adoRS.UpdateBatch adAffectAllChapters ' update them all in one step!
'
End Sub

クエリのテーブル名を正しいテーブルに変更し、ワークシートの列がテーブルの列と同じ順序とデータ型であることを確認してください

ADO レコードセットのヘルプについては、次を参照してください。

MSDN ライブラリ - ADO レコードセット、AddNew メソッド

と

MSDN ライブラリ - ADO レコードセット、UpdateBatch

と

W3Schools

始められることを願っています！

フィリップ

于 2013-03-13T15:14:16.283 に答える