用VBA计算来代替函数公式

jackyava · 发表于 2017-5-17 22:31

本帖最后由 jackyava 于 2017-5-18 22:52 编辑

R:T列的公式是依次用每2个编号的数据进行计算。
要求：
1.用VBA计算来替代原来的公式并显示结果。
2.不要用整型变量，因为有时要处理小数。
3.添加字体背景颜色
正常：粉底黄字
反常：绿底黄字
无：兰底白字

附件

计算.rar (6.41 KB, 下载次数: 5)

池盛龙 · 发表于 2017-5-18 10:02

太麻烦，没有人做你的，没有人为了一个贴花半天的时间

grf1973 · 发表于 2017-5-18 13:47

1、公式可以简化：=CHOOSE(SIGN((N4-N3)*((O4*P4)/(N4*P4+N4*O4+O4*P4)-(O3*P3)/(N3*P3+N3*O3+O3*P3)))+2,"正常","无","反常")
2、代码如下：

Sub tt()
arr = Range("n3:p20")
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
s = arr(i, 1) * arr(i, 2) + arr(i, 1) * arr(i, 3) + arr(i, 2) * arr(i, 3)
t = arr(i, 1) * arr(i, 2) * arr(i, 3)
s1 = arr(i - 1, 1) * arr(i - 1, 2) + arr(i - 1, 1) * arr(i - 1, 3) + arr(i - 1, 2) * arr(i - 1, 3)
t1 = arr(i - 1, 1) * arr(i - 1, 2) * arr(i - 1, 3)
For j = 1 To 3
x = (arr(i, j) - arr(i - 1, j)) * (t / s / arr(i, j) - t1 / s1 / arr(i - 1, j))
brr(i, j) = Choose(Sgn(x) + 2, "正常", "无", "反常")
Next
Next
[x3].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

复制代码

jackyava · 发表于 2017-5-18 15:02

grf1973 发表于 2017-5-18 13:47
1、公式可以简化：=CHOOSE(SIGN((N4-N3)*((O4*P4)/(N4*P4+N4*O4+O4*P4)-(O3*P3)/(N3*P3+N3*O3+O3*P3)))+2," ...

老师能不能把字体颜色也加上，谢谢

jackyava · 发表于 2017-5-18 15:07

jackyava 发表于 2017-5-18 15:02
老师能不能把字体颜色也加上，谢谢

arr = Range("n3:p65536")这么改的话，提示溢出

jackyava · 发表于 2017-5-20 19:11

本帖最后由 jackyava 于 2017-5-20 19:13 编辑

grf1973 发表于 2017-5-18 13:47
1、公式可以简化：=CHOOSE(SIGN((N4-N3)*((O4*P4)/(N4*P4+N4*O4+O4*P4)-(O3*P3)/(N3*P3+N3*O3+O3*P3)))+2," ...

老师，您有时间的话，帮忙看下这个题，谢谢，也是用VBA来实现效果（数据量大，未一一例举详见附件）

附件

		自动登录	找回密码
密码			注册