sk
2024/10/29 (火) 13:29:56
db462@28ef2
下記のコードを利用すると、更新されるところと、更新されないところがあります。
Do Until .Cells(i, "K") = ""
strSQL = "UPDATE Q_単価更新用 SET 仕入=" & .Cells(i, "I") & " WHERE 更新合成キー ='" & .Cells(i, "K").Value & "'"adoCn.Execute strSQL
i = i + 1
Loop
途中のデータ行の K 列の値が Empty 値 / 空文字列 であるため、全てのデータ行を網羅し切る前にループ処理が終了している。
途中のデータ行の I 列の値が数値(もしくは数値データに変換可能な文字列)ではないため、SET 句の右辺が抜けて構文エラーが発生している。
単純に、フィールドの[更新合成キー]の値が 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
とりあえず、以上のマクロを実行してみて
イミディエイトウィンドウに出力された結果を
確認してみて下さい。
通報 ...