vba代码请教

Question

如题所述

Answer 1

Dim s1 As Integer
Dim s2 As Integer
Dim i As Integer

s1 = 0
s2 = 0
For i = 1 To 7
s1 = s1 + Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value
s2 = s2 + Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value
Next i

Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(8, 2).Value = s1
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(8, 4).Value = s2

Do While s1 <> s2
If s1 > s2 Then
i = 1
Do While Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value = ""
i = i + 1
Loop
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value = Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value - 1
If Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value = 0 Then
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value = ""
End If
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value = Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value + 1

s1 = 0
s2 = 0
For i = 1 To 7
s1 = s1 + Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value
s2 = s2 + Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value
Next i
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(8, 2).Value = s1
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(8, 4).Value = s2
Else
i = 1
Do While Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value = ""
i = i + 1
Loop
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value = Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value - 1
If Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value = 0 Then
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value = ""
End If
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value = Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value + 1

s1 = 0
s2 = 0
For i = 1 To 7
s1 = s1 + Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 1).Value
s2 = s2 + Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(i, 3).Value
Next i
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(8, 2).Value = s1
Excel.Application.ActiveWorkbook.Sheets("Sheet1").Cells(8, 4).Value = s2

End If
Loop追问

非常感谢你，但是出现一种情况如果循环后b8和d8不相等那么就出现死循环了，Do While s1 s2
可以修改成s1和s2相差最少吗，因为真实的数据包含小数点所以只要s1和s2相差为最小就可以，该怎么实现呢，感谢大侠

追答

你好！
昨天，我在编写的时候，随意给了个数据，也发现了这个问题，当时我以为你的数据是有规律的，或者自己会校验数据的合理性。
因为，当两边的总数一个为偶数，一边为奇数，就会死循环的。

可以改成两者的差满足一定小，就结束的。

问题，因为你每次是，减1、加1，其实修改很容易；

你可以看到，循环的条件：Do While s1 s2

就是：s1 s2
你只要改成：Abs(s1 - s2) < 某个值，就可以了。
问题是，因为你是：减1、加1，所以，Abs(s1 - s2)的最小值分几种情况：

1，两边总数的整数部分的奇偶性一致；那么这个差值就是：小于1的
2，两边总数的整数部分的奇偶性不一致；那么这个差值就是：大于1并且小于2的。

所以，你要考虑，如何确定这个差的最小值。一般的方法就是：Abs(s1 - s2) < 2
所以，你只要改一句代码：
Do While Abs(s1 - s2) < 2

其中：Abs（）函数是VB的绝对值函数

Answer 2

sub a()
i=1
if cells(8,2)-cells(8,4) then
a=2
b=4
else
a=4
b=2
end if
do while cells(8,a)-cells(8,b)>1
do while cells(i,a).value=0
i=i 1
if i=8 then end
loop
cells(i,a)=cells(i,a)-1
if cells(i,a).value=0 then
cells(i,a)=""
end if
cells(i,b)=cells(i,b) 1
loop

end sub