Excel VBA 计算两个单元格之间的差异 + 如果超过差异则添加字符

Question

所以我四处寻找类似的东西，所有其他人的问题似乎都与相邻列中的数字有关。我正在尝试为我的公司清理多年前创建的价差sheet。在上面输入数据的女孩 Excel 知识很少，习惯了在这种布局中输入的东西，所以我不是特别想重新创建整个传播sheet...这是我的问题哈哈

我有两行数据（在同一列），有一个跳过单元格然后重复。这持续了大约 250 行，每行都是 "paired" 结果，但在同一列中，中间有一个跳过单元格。我只需要找到这两者之间的区别，例如测试结果 #1 和它与下面的我们的计算 #1 配对（彼此在 10% +/- 以内）并用“*”标记对中的顶部单元格在单元格中已经存在的数字之后。

示例：第一对在我们计算的 +/- 10% 内，第二对超出该范围。
测试结果 #1 12.5
我们的计算 #1 11.9
空单元格
测试结果 #2 15.0*
我们的计算 #2 13.0

我知道要获取“*”，我会使用 if-then-else 语句，这没问题。但我正在努力弄清楚如何（如果可能的话）计算差异。我的 sheet 也有 6 列相同的布局（我们正在查看的 X 样本的每个参数一列）。

如有任何正确方向的指点，我们将不胜感激！谢谢！

Answer 1

这是我做的一个快速模型，它应该可以满足您的要求 - 您可能只需要调整列，因为我在 A 列中制作了模拟数据。

另请注意，为了安全起见，为了获取测试和计算的值，我选择获取最后 4 位数字。如果您需要更多或更少，只需更改括号中的最后一个数字即可。

Dim test As Double
Dim calc As Double

For i = 1 To Cells(Rows.count, "A").End(xlUp).row Step 3

    test = Right$(Cells(i, "A").Value2, 4)
    calc = Right$(Cells(i + 1, "A").Value2, 4)

    If Abs(test - calc) / calc > 0.1 Then
        Cells(i, "A").Value2 = Cells(i, "A").Value2 & "*"
    End If
Next i

Answer 2

使用 end(up) 会漏掉最后一对下方的最后一个空白单元格。我是这样做的：

Sub QuikandDirty()
            Dim r As Range
            For Each r In Intersect(ActiveSheet.Columns("a").Cells, ActiveSheet.UsedRange.Offset(1, 0)) 'assume col A
            If r = 0 Then
                If Abs(r.Offset(-2, 0) - r.Offset(-1, 0)) > (r.Offset(-2, 0) / 10) Then
                   r.Offset(-2, 0).Formula = CStr(r.Offset(-2, 0).Formula) & "*"
                End If
            End If
            Next r
            End Sub

Excel VBA 计算两个单元格之间的差异 + 如果超过差异则添加字符

Excel VBA Calculating difference between two cells + adding characters if difference is exceeded

excel

vba

difference