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

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

sk様　いつもありがとうございます。

更新結果は、０件でした。

更新合成キーが存在しないんですね。

sk様
更新結果は、イミディエイトウィンドウでは、０件でしたが、実際は、３件更新されました

一例ですが、

ACCESS上の更新合成キー　126-1200-30-202410
Excel上の更新合成キー　 126-1200-30-202410

目検で同じように見えますし、EXACT関数で確認しても、Trueとなり、同じように見えます。

これがなぜ更新できないのかが、わからないでです。

一応、ACCESSのクエリ上で確認しました。

正誤:iif([Q_単価更新用].[更新合成キー]=[転送用シート].[更新合成キー],"〇","×")

〇の判定は、184個あり、私の認識では、184個更新されると思うのですが、そんな単純な話ではないのでしょうか？

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

For～Nextで検証しましたが、更新されませんでした。

I列は、

Sub 単価()
Dim ws_2 As Worksheet
Set ws_2 = Worksheets("転送用シート")
maxR = Cells(Rows.Count, "A").End(xlUp).Row
maxR2 = ws_2.Cells(Rows.Count, "A").End(xlUp).Row

hajimeGyo = ActiveCell.Row
hajimeRetu = ActiveCell.Column

Range(Cells(hajimeGyo + 1, hajimeRetu), Cells(maxR, ActiveCell.Column)).Copy
ws_2.Cells(2, "I").PasteSpecial xlPasteValues

For i = 2 To maxR2


If ws_2.Cells(i, "I") = "" Then
ws_2.Cells(i, "I") = 0

End If
Next i

End Sub

このようになコードです

2024/10/1を202410に変更しています。

すいません
間違えました。
I列は、少数点の数値です。
152.2などです
×2024/10/1を202410に変更しています⇒間違えました

実際に実行されたSQLを確認してみては？

Execute メソッド (ADO Connection)

Dim RecordsAffected As Long
adoCn.Execute strSQL, RecordsAffected
If RecordsAffected = 0 Then
    Debug.Print strSQL
    Stop
End If

hiroton様

コード提示ありがとうございます。

私、ヘルプも読んだのですが、理解ができません。

このコードは、どこに差し込むのでしょうか？

また独立で、作動させるのでしょうか？

お手すきの時に回答いただけたら幸いです。
よろしくお願いいたします。

更新結果は、イミディエイトウィンドウでは、０件でしたが、実際は、３件更新されました

それは私の例示したマクロをそっくりそのままコピーして実行したのではなく、ご自身が作成されたマクロを部分的に修正されたものを実行されたからではないでしょうか。

例えば、Execute メソッドの呼び出し時に引数 RecordAffected に Long 型の変数（ lngRecordAffected ）を渡していない、RecordAffected を介して取得した更新件数を別の Long 型の変数（ lngAffectedTotal ）に累計加算する処理を記述していない等。

更新合成キーが異なるのかと思い、VLOOKUP関数で、Excel上で検証しましたが、VLOOKUP関数では反応します。

目検で同じように見えますし、EXACT関数で確認しても、Trueとなり、同じように見えます。

比較/更新対象となるのはあくまで Access 側のテーブル/フィールドですので、Excel ワークシート側のデータのみを検証しても正確なことは判らないでしょう。

正誤:iif([Q_単価更新用].[更新合成キー]=[転送用シート].[更新合成キー],"〇","×")

その部分だけを示されても、検証用のクエリが適切に作られているかどうか評価のしようがありません。

また[Q_単価更新用]という名前から推察した限り、UPDATE 文において呼び出されているのはテーブルではなく選択クエリのように見えますが、もし[Q_単価更新用]が選択クエリであるならば、それが具体的にどのようなクエリであるか、実際に更新対象となるのはどのテーブルであるか、そのテーブルの各フィールド（特に[更新合成キー]）はどのように定義されているのか、といったことも検討すべき問題となります。

[Q_単価更新用]がテーブルではなく選択クエリであるならば、とりあえずそのクエリの SQL ビューの内容をそのまま明示して下さい。

仕入は、数値型です。

I列は、少数点の数値です。

Access 側のテーブルにおけるフィールド[仕入]のフィールドサイズ（十進型である場合は[精度]および[小数点以下保持桁数]プロパティ）はどのように設定されているのでしょうか。

更新を実行したいクエリのSQL文は、下記の通りです。

SELECT ID, 
仕入コード,
仕入先,
油種コード,
単価_ランク, 
単価_ランク_コード, 
直近3ヶ月, 
仕入, 
Left(Format([直近3ヶ月],"yyyymmdd"),6) AS 日付コード,
 [仕入コード] & "-" & [油種コード] & "-" & [単価_ランク_コード]& "-" &[日付コード] AS 更新合成キー,
FROM MT_検索テーブル;

仕入のフィールドの型は、
単精度浮動小数点型です。

昨日からのアドヴァイスをいただき、検証しました。

実際に利用している単価更新キーは

00-0000-00-202410

このような文字列です。

SQL文に記載のある

Left(Format([直近3ヶ月],"yyyymmdd"),6)

この値をつけると更新できませんが、この値をつけなければ更新できます。

00-0000-00　⇒更新できます。

sk様のコードでも確認して、更新件数は合致します。

Excel上のマクロは下記の通りです。

.Range(.Cells(2, "J"), .Cells(maxR, "J")) = Format(ActiveCell.Value, "yyyymm")

疑問なのですが、

Left(Format([直近3ヶ月],"yyyymmdd"),6)

.Range(.Cells(2, "J"), .Cells(maxR, "J")) = Format(ActiveCell.Value, "yyyymm")

このコードを実行すると、202410になりますが、ExcelとACCESSでは、異なる値と判断されるのでしょうか？

sk様返信ありがとうございます。

＞＞Access側のテーブル[MT_検索テーブル]のフィールド[直近3ヶ月]のデータ型は日付/時刻型なのでしょうか。

日付/時刻型です。

>>Excel 側のワークシート[転送用シート]において、K 列の各セルは J 列を含む他の列のセルを参照する数式セルなのでしょうか。

.Cells(i, "K") = .Cells(i, "A") & "-" & .Cells(i, "E") & "-" & .Cells(i, "G") & "-" & .Cells(i, "J")

>>
また、[仕入コード]、[油種コード]および[単価_ランク_コード]に相当する列は、Excel 側のワークシート[転送用シート]に存在していないのでしょうか。

存在しています。
Cells(i, "A")⇒仕入コード
Cells(i, "E")⇒油種コード
Cells(i, "G")⇒単価ランクコード
Cells(i, "J")⇒日付コード

です

クエリでは、更新できませんでしたが、テーブルに変更すると、更新ができました。
理由は不明です。

sk様　いつもありがとうございます。私の不手際で、気分を害されたら、お詫びします。
また、検証用のコードありがとうございました。
このようなコードで、検証できるように、精進します。

hiroton様

いつも回答ありがとうございます。
hiroton様の検証用のコードも理解できませんでしたので、理解できるように精進します。

お騒がせして申し訳ありません。

ありがとうございました。

hirotonの回答は「実際に実行されたSQLを表示する」だけです
続く条件判定により「『更新されない』時だけSQLが表示される」ことを期待しています

結果を見てできることを質問者さんが考えてもいいですし、そのまま結果を提示してもらえれば問題解決に一歩近づくだろうという検証をするための情報を生み出すコードです

このコードの実行結果はいくつか想定されます。たとえば

• 特に変化が見られず、処理が終了した
• Stop行が実行され（処理が中断し）、SQLが表示された

大きく分ければこの二つしかありませんが、SQLが表示されれば

• SQLが表示されたが、EXCELの内容から期待したSQLになっていなかった
• SQLが表示され、EXCELの内容から期待したSQLが表示された

のように、内容を深堀することもできます。当然、「SQLが表示されることなく処理が終了した」の結果ならその先の想定も無意味なものになるので、hirotonの最初のアプローチとしては「実際に実行されたSQLを確認してみては？」で止まっているわけです
回答で想定されているパターンを網羅するのは質問に対して不要な情報であふれることになりトピックの質が落ちますし、１つの正解以外は徒労というのもhirotonはやりたくありません

自己解決した内容をみるに、実行されるSQLは期待した文字列だったものと思われます。SQLが正しく実行されるかどうかのほうに問題があり、つまり、EXCELからの読み込み部分は問題ないのだと確認が取れるでしょう

ならば、EXCELのデータやその取り込み部分をいくら深堀したところで問題は解決しません

問題解決のために何が必要か？複数のアプローチを検討・実施することが問題解決の近道になります

hiroton様

貴重なご意見ありがとうございました。

＞＞問題解決のために何が必要か？複数のアプローチを検討・実施することが問題解決の近道になります

その通りだと思います。
今後に向けて精進します。