如何将含特定文本的公式单元格以值形式复制到另一个工作表？

问题根源 #

• #REF!错误：原代码大概率直接引用了公式本身而非计算后的值，或是引用了已被修改/删除的无效单元格范围
• INSERT语句内容缺失：原代码未正确提取公式计算出的完整数据集，或是字符串拼接逻辑遗漏了字段内容

修正后的VBA代码 #

Sub GenerateLocationInserts()
    Dim locWS As Worksheet, sqlWS As Worksheet
    Dim cell As Range
    Dim sqlRow As Long
    Dim formulaResult As Variant
    Dim insertStr As String
    Dim valuesArr As Variant
    Dim i As Long, j As Long
    
    ' 绑定目标工作表
    Set locWS = ThisWorkbook.Worksheets("LOCATIONS")
    Set sqlWS = ThisWorkbook.Worksheets("SQL")
    
    ' 清空SQL工作表原有内容（按需保留）
    sqlWS.Cells.Clear
    sqlRow = 1
    
    ' 遍历LOCATIONS中包含目标公式的单元格
    For Each cell In locWS.UsedRange
        If cell.HasFormula And InStr(cell.Formula, "dbo.Location") > 0 Then
            ' 获取公式计算后的实际值，而非公式文本
            formulaResult = cell.Value
            
            ' 处理公式返回的数组结果（这类查询公式通常返回多行多列数据）
            If IsArray(formulaResult) Then
                valuesArr = formulaResult
                For i = LBound(valuesArr, 1) To UBound(valuesArr, 1)
                    insertStr = "INSERT INTO dbo.Locations VALUES ("
                    ' 逐字段拼接，适配不同数据类型
                    For j = LBound(valuesArr, 2) To UBound(valuesArr, 2)
                        Select Case VarType(valuesArr(i, j))
                            Case vbString, vbDate
                                ' 替换单引号避免SQL语法错误
                                insertStr = insertStr & "'" & Replace(valuesArr(i, j), "'", "''") & "', "
                            Case vbNull, vbEmpty
                                insertStr = insertStr & "NULL, "
                            Case Else
                                insertStr = insertStr & valuesArr(i, j) & ", "
                        End Select
                    Next j
                    ' 移除末尾多余的逗号并闭合语句
                    insertStr = Left(insertStr, Len(insertStr) - 2) & ")"
                    ' 写入SQL工作表
                    sqlWS.Cells(sqlRow, 1).Value = insertStr
                    sqlRow = sqlRow + 1
                Next i
            Else
                ' 处理单个值的特殊情况（按需调整）
                insertStr = "INSERT INTO dbo.Locations VALUES ('" & Replace(formulaResult, "'", "''") & "')"
                sqlWS.Cells(sqlRow, 1).Value = insertStr
                sqlRow = sqlRow + 1
            End If
        End If
    Next cell
    
    MsgBox "INSERT语句生成完成！", vbInformation
End Sub

核心修正说明 #

• 直接提取单元格计算后的值，彻底避免#REF!引用错误
• 适配公式返回的数组结果，确保完整提取所有行数据
• 针对不同数据类型做格式处理，保证SQL语句语法合法
• 替换字符串中的单引号为双单引号，防止SQL注入或语法报错
• 遍历已使用范围，避免无效单元格引用

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