基于条目更新数据库值的宏故障：价格同步失效求助

我一眼就发现问题出在哪了——你写的代码只是把新价格存到了Ret变量里，根本没把这个值写回db工作表的对应单元格！这就是为啥修改当前表价格后，数据库完全没动静的原因。

原代码的核心问题 #

你这段代码里的If Ret <> Cur Then Ret = Cur，只是在内存里更新了变量的值，没有对工作表的单元格执行写入操作，自然不会改变db表的内容。

修正后的代码 #

我给你调整了代码，用Match函数定位db表里对应条目的行号，然后直接修改该行第5列（也就是你VLOOKUP取的列）的值，这样就能实现同步更新了：

Sub valueUpdater()
    Dim cell As Range
    Dim dbSheet As Worksheet
    Dim matchRow As Variant
    Dim currentPrice As Variant
    Dim dbPrice As Variant
    
    ' 先把db工作表赋值给变量，方便后续调用
    Set dbSheet = ThisWorkbook.Worksheets("db")
    
    ' 遍历当前表的条目范围（A9:A20）
    For Each cell In ThisWorkbook.ActiveSheet.Range("A9:A20")
        ' 跳过空单元格，避免无效查找
        If cell.Value <> "" Then
            ' 用Match找到db表里对应条目的行号
            matchRow = Application.Match(cell.Value, dbSheet.Range("A2:A14"), 0)
            
            ' 如果找到匹配条目
            If Not IsError(matchRow) Then
                ' 获取当前表的价格（对应原代码VLOOKUP第4列，即A列+3的D列）
                currentPrice = ThisWorkbook.ActiveSheet.Cells(cell.Row, cell.Column + 3).Value
                ' 获取db表的价格（第5列，即E列）
                dbPrice = dbSheet.Cells(matchRow + 1, 5).Value ' Match从A2开始，行号需+1
                
                ' 对比价格，不一致就更新db表
                If dbPrice <> currentPrice Then
                    dbSheet.Cells(matchRow + 1, 5).Value = currentPrice
                    ' 可选：添加调试提示，方便查看更新记录
                    ' Debug.Print "更新了条目：" & cell.Value & " 价格从" & dbPrice & "改为" & currentPrice
                End If
            Else
                ' 找不到匹配条目的时候给出提示
                Debug.Print "未找到条目：" & cell.Value & " 在db表中"
            End If
        End If
    Next cell
End Sub

关键说明 #

• 用Match代替两次VLOOKUP：更高效，而且能直接定位到具体行，方便后续写入操作
• 直接操作单元格：通过dbSheet.Cells(matchRow + 1, 5).Value = currentPrice把新价格写入db表，这才是实现同步的核心
• 增加空单元格判断：避免对空值进行无效查找，减少错误
• 错误处理：用IsError(matchRow)判断是否找到匹配条目，防止程序报错

这样修改后，当你修改当前工作表的价格时，db表对应的价格就会同步更新啦！

内容的提问来源于stack exchange，提问作者GreakFreak