Excel 2010からテーブルをExcel VBAから更新する1レコードのみを更新する

Question

アクセステーブルをExcelから更新しようとするとかなりの時間がかかります。私はADOB Connectionを使用しており、更新があるスプレッドシートをループしています。これは、200レコードから1000レコードまでです。

次のコードを実行すると、テストデータから1047レコードが更新されているにもかかわらず、アクセステーブルのレコードが1つだけ更新されます。

62個の列を持つ販売記録を更新しています。カラム「BI」は、引用の際に生成される固有のIDである。更新が指定しているのは、列BI（sQID）のIDに基づいて、QorB列のデータをQからBに変更することです。

モジュールが実行された後、アクセスDBはレコードが1つしか変わっていないことを示しています。私は迷っています。

誰もが以下のコードで何か劇的に間違っているのを見ることができますか？ Excelから大量のデータを使ってアクセスを更新するより良い方法はありますか？

Sub updatedbtest2() 

Dim cn As ADODB.Connection, rs As ADODB.Recordset 
Dim rng As Range 
Dim lngRow As Long 
Dim lngID, LR, Upd 
Dim sSQL As String 

'Get Last Row of range used 
LR = Range("BI" & Rows.Count).End(xlUp).Row 

Upd = LR - 1 
lngRow = 2  
Do While lngRow <= LR 
lngID = Cells(lngRow, 61).Value 

    Set cn = New ADODB.Connection 
    cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _ 
    "Data Source=C:\Database\sales.accdb;" 

sQID = Cells(2, 61).Value 

    Set rs = New ADODB.Recordset 

     sSQL = "SELECT * FROM P&R WHERE QuoteID ='" & sQID & "';" 

rs.Open Source:=sSQL, ActiveConnection:=cn, LockType:=adLockOptimistic 

     ' update fields within table with values from spreadsheet. 
     With rs 
      .Fields("QorB") = Cells(lngRow, 60).Value 
      .Fields("BDate") = Cells(lngRow, 62).Value 
      .update 
     End With   
    rs.update 
    'Next rng 

lngRow = lngRow + 1 

    rs.Close 
    Set rs = Nothing 
    cn.Close 
    Set cn = Nothing  


Loop 

MsgBox "You just updated " & Upd & " records" 
End Sub 

ありがとうございます。

私は、同じ正確な結果を持つ提案から次のコードに変更を加えました。

Snip of Access showing records

Sub updatedbtest2() 

Dim cn As ADODB.Connection, rs As ADODB.Recordset 
Dim rng As Range 
Dim lngRow As Long 
Dim sQID, LR 
Dim sSQL As String 

LR = Range("A" & Rows.Count).End(xlUp).Row 
Debug.Print LR 


Upd = LR - 1 
lngRow = 2 
sQID = Cells(lngRow, 61).Value 

'Do While lngRow <= LR 

    Set cn = New ADODB.Connection 
    cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _ 
    "Data Source=C:\Database\sales.accdb;" 

    Set rs = New ADODB.Recordset 

     sSQL = "SELECT * FROM PandR WHERE QID ='" & sQID & "';" 

    rs.Open Source:=sSQL, ActiveConnection:=cn, LockType:=adLockOptimistic 

     Do While lngRow <= LR 

     With rs 
      .Fields("QorB") = Cells(lngRow, 60).Value 
      .Fields("BDate") = Cells(lngRow, 62).Value 
      .update 

     End With 

    'Next rng 
    lngRow = lngRow + 1  

    Loop  

    rs.Close 
    Set rs = Nothing 
    cn.Close 
    Set cn = Nothing 

End Sub 

Answer 1

あなたは、ハードコードの行です：次に

sQID = Cells(lngRow, 61).Value 

： `sQIDは=細胞（2、61）.Valueの

をあなたがでこれを置き換える必要がありますそれは同じ行為を引き受けるのではなく、次の行からの価値を取ります。

更新：Scott Holzmanが先にそこに着いた！

Answer 2

あなたが期待するように、このコードは動作するはずです：

Sub updatedbtest2() 

Dim cn As ADODB.Connection, rs As ADODB.Recordset 
Dim rng As Range 
Dim lngRow As Long 
Dim sQID, LR 
Dim sSQL As String 

LR = Range("A" & Rows.Count).End(xlUp).Row 
'Debug.Print LR 

'Upd = LR - 1 
lngRow = 2 

Set cn = New ADODB.Connection 
cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _ 
    "Data Source=C:\Database\sales.accdb;" 

Do While lngRow <= LR 

    sQID = Cells(lngRow, 61).Value 

    Set rs = New ADODB.Recordset 
    sSQL = "SELECT * FROM PandR WHERE QID ='" & sQID & "';" 

    With rs 
     .Open Source:=sSQL, ActiveConnection:=cn, LockType:=adLockOptimistic 

     .Fields("QorB") = Cells(lngRow, 60).Value 
     .Fields("BDate") = Cells(lngRow, 62).Value 

     .Update 

    End With 

    'Next rng 
    lngRow = lngRow + 1 

    rs.Close 
    Set rs = Nothing 

Loop 

cn.Close 
Set cn = Nothing 

End Sub