Microsoft Access 掲示板

下記のコードを利用すると、更新されるところと、更新されないところがあります。

    Do Until .Cells(i, "K") = ""
         strSQL = "UPDATE Q_単価更新用 SET 仕入=" & .Cells(i, "I") & " WHERE  更新合成キー ='" & .Cells(i, "K").Value & "'"

         adoCn.Execute strSQL
         i = i + 1
    Loop

1. 途中のデータ行の K 列の値が Empty 値 / 空文字列 であるため、全てのデータ行を網羅し切る前にループ処理が終了している。

2. 途中のデータ行の I 列の値が数値（もしくは数値データに変換可能な文字列）ではないため、SET 句の右辺が抜けて構文エラーが発生している。

3. 単純に、フィールドの[更新合成キー]の値が K 列の値と一致するレコードが[Q_単価更新用]側に存在していない。

以前ご質問された件を踏まえると、恐らく 3 である可能性の方が高いのではないかと推察します。

Sub UpdatePrices()
    
    Dim wsSource As Worksheet
    Dim lngFirstRow As Long
    Dim lngLastRow As Long
    
    Set wsSource = Worksheets("転送用シート")
    
    With wsSource
        lngFirstRow = 2
        lngLastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
        If lngFirstRow > lngLastRow Then
            Debug.Print "ワークシート[" & wsSource & "]にデータ行がありません。"
            Set wsSource = Nothing
            Exit Sub
        End If
    End With
    
    Dim adoCn As Object     'ADODB.Connection
    Dim strDbName As String
    Dim strTargetPath As String
    
    Set adoCn = CreateObject("ADODB.Connection")
    
    strDbName = Worksheets("Sheet1").Range("D1")
    strTargetPath = ThisWorkbook.Path & strDbName
    Debug.Print strTargetPath
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strTargetPath & ";"
    
    Dim adoCmd As Object    'ADODB.Command
    Dim strSQL As String
    
    Set adoCmd = CreateObject("ADODB.Command")
        
    With adoCmd
        Set .ActiveConnection = adoCn
        .CommandType = 1    'adCmdText
        strSQL = "PARAMETERS [SearchKey] TEXT(255), [UpdateValue] INT;" & vbCrLf & _
                 "UPDATE [Q_単価更新用] AS q1" & _
                 " SET q1.[仕入]=[UpdateValue]" & _
                 " WHERE q1.[更新合成キー]=[SearchKey];"
        Debug.Print strSQL
        .CommandText = strSQL
        .Parameters.Append .CreateParameter("SearchKey", 202, 1, 255)   'adVarWChar, adParamInput
        .Parameters.Append .CreateParameter("UpdateValue", 3, 1)        'adInteger, adParamInput
    End With
        
    Dim lngRow As Long
    Dim lngRecordAffected As Long
    Dim lngAffectedTotal As Long
    Dim rngKeyCell As Range
    Dim rngValueCell As Range
    
    lngAffectedTotal = 0
    
    For lngRow = lngFirstRow To lngLastRow
        
        Set rngKeyCell = wsSource.Cells(lngRow, "K")
        Set rngValueCell = wsSource.Cells(lngRow, "I")
        lngRecordAffected = 0
        
        If (rngKeyCell.Value <> "") And (IsNumeric(rngValueCell.Value) = True) Then
            adoCmd.Parameters("SearchKey").Value = rngKeyCell.Value
            adoCmd.Parameters("UpdateValue").Value = CLng(rngValueCell.Value)
            adoCmd.Execute lngRecordAffected
        End If
        
        If lngRecordAffected = 0 Then
            Debug.Print lngRow & "行目のデータは更新対象になりませんでした。"
            Debug.Print vbTab & rngKeyCell.Address(False, False) & "セルの値: " & rngKeyCell.Value
            Debug.Print vbTab & rngValueCell.Address(False, False) & "セルの値: " & rngValueCell.Value
        ElseIf lngRecordAffected > 1 Then
            Debug.Print lngRow & "行目の更新合成キー（" & rngKeyCell.Value & "）に該当するレコードが " & _
                        lngRecordAffected & " 件更新されました｡"
        End If
        
        lngAffectedTotal = lngAffectedTotal + lngRecordAffected
        
        Set rngKeyCell = Nothing
        Set rngValueCell = Nothing
    
    Next
    
    Set adoCmd = Nothing
    adoCn.Close
    Set adoCn = Nothing
    
    Debug.Print "全部で " & lngAffectedTotal & " 件のレコードが更新されました。"
    
End Sub

とりあえず、以上のマクロを実行してみて
イミディエイトウィンドウに出力された結果を
確認してみて下さい。