求助……工程测量计算VBA编写

wwz0913

jsxjd 发表于 2013-7-14 21:38
估计楼主初次接触VBA，简单点，想实现什么功能？

Sub 右()
Dim l, b#, I%
I = 4
Do
l = Cells(I, 1)
  If 17371.6 <= l And l <= 17500.85 Then
       b = 20.311 + (l - 17371.6) * 2 / 1000
  ElseIf 17500.85 <= l And l <= 17518 Then
        b = 20.57 + (l - 17500.85) * 2 / 1000 + (l - 17500.85) ^ 2 / (2 * 5000)
ElseIf 17518 <= l And l <= 17535.15 Then
        b = 20.633 + (l - 17518) * 8.86 / 1000 + (l - 17518) ^ 2 / (2 * 5000)
ElseIf 17535.15 <= l And l <= 17700 Then
        b = 20.756 + (l - 17535.15) * 8.86 / 1000
ElseIf 17700 <= l And l <= 17707.98 Then
        b = 22.217 + (l - 17700) * 8.86 / 1000 - (l - 17700) ^ 2 / (2 * 5000)
ElseIf 17707.98 <= l And l <= 17714.68 Then
        b = 22.283 + (l - 17707.98) * 6.18 / 1000 - (l - 17707.98) ^ 2 / (2 * 5000)
ElseIf 17714.68 <= l And l <= 17817.85 Then
        b = 22.329 + (l - 17714.68) * 6.18 / 1000
ElseIf 17817.85 <= l And l <= 17878.3 Then
        b = 22.966 + (l - 17817.85) * 6.18 / 1000 + (l - 17817.85) ^ 2 / (2 * 5000)
ElseIf 17878.3 <= l And l <= 17938.75 Then
        b = 22.974 + (l - 17878.3) * 18 / 1000 + (l - 17878.3) ^ 2 / (2 * 5000)
ElseIf 17938.75 <= l And l <= 17988.953 Then
        b = 22.252 - (l - 17938.75) * 18 / 1000
   Else
MsgBox "超出里程范围"
End If
Cells(I, 2) = b
I = I + 1
Loop Until Cells(I, 1) = ""
End Sub
现在公式都对了，可是进行某些运算时结果却不对！

wwz0913

wwz0913 发表于 2013-7-16 21:32
我想用与计算的

Sub 右()
Dim l, b#, I%
I = 4
Do
l = Cells(I, 1)
  If 17371.6 <= l And l <= 17500.85 Then
       b = 20.311 + (l - 17371.6) * 2 / 1000
  ElseIf 17500.85 <= l And l <= 17518 Then
        b = 20.57 + (l - 17500.85) * 2 / 1000 + (l - 17500.85) ^ 2 / (2 * 5000)
ElseIf 17518 <= l And l <= 17535.15 Then
        b = 20.633 + (l - 17518) * 8.86 / 1000 + (l - 17518) ^ 2 / (2 * 5000)
ElseIf 17535.15 <= l And l <= 17700 Then
        b = 20.756 + (l - 17535.15) * 8.86 / 1000
ElseIf 17700 <= l And l <= 17707.98 Then
        b = 22.217 + (l - 17700) * 8.86 / 1000 - (l - 17700) ^ 2 / (2 * 5000)
ElseIf 17707.98 <= l And l <= 17714.68 Then
        b = 22.283 + (l - 17707.98) * 6.18 / 1000 - (l - 17707.98) ^ 2 / (2 * 5000)
ElseIf 17714.68 <= l And l <= 17817.85 Then
        b = 22.329 + (l - 17714.68) * 6.18 / 1000
ElseIf 17817.85 <= l And l <= 17878.3 Then
        b = 22.966 + (l - 17817.85) * 6.18 / 1000 + (l - 17817.85) ^ 2 / (2 * 5000)
ElseIf 17878.3 <= l And l <= 17938.75 Then
        b = 22.974 + (l - 17878.3) * 18 / 1000 + (l - 17878.3) ^ 2 / (2 * 5000)
ElseIf 17938.75 <= l And l <= 17988.953 Then
        b = 22.252 - (l - 17938.75) * 18 / 1000
   Else
MsgBox "超出里程范围"
End If
Cells(I, 2) = b
I = I + 1
Loop Until Cells(I, 1) = ""
End Sub
运算后部分条件运算结果不符

jsxjd

用太多的 IF 结构性不好，可以考虑用 Select case

wwz0913

jsxjd 发表于 2013-7-16 22:48
用太多的 IF 结构性不好，可以考虑用 Select case

select case  不是很会用， select case l
                                    case is  后边跟并列语句不知怎么用，每次都只执行第一个条件，不管满足不满足！求高人指点！

jsxjd

网上搜搜相应的代码，或者发代码让人看一下

wwz0913

jsxjd 发表于 2013-7-18 08:01
网上搜搜相应的代码，或者发代码让人看一下

o  谢谢了！

黄家驹

改变地球的一代人

grf1973

用Select Case改写：

1. Sub 右()
   
2.     Dim L, b#, I%
   
3.     I = 4
   
4.     Do
   
5.         L = Cells(I, 1)
   
6.         Select Case L
   
7.             Case Is < 17371.6
   
8.                 MsgBox "超出里程范围"
   
9.             Case Is <= 17500.85
   
10.                b = 20.311 + (L - 17371.6) * 2 / 1000
    
11.             Case Is <= 17518
    
12.                 b = 20.57 + (L - 17500.85) * 2 / 1000 + (L - 17500.85) ^ 2 / (2 * 5000)
    
13.             Case Is <= 17535.15
    
14.                 b = 20.633 + (L - 17518) * 8.86 / 1000 + (L - 17518) ^ 2 / (2 * 5000)
    
15.             Case Is <= 17700
    
16.                 b = 20.756 + (L - 17535.15) * 8.86 / 1000
    
17.             Case Is <= 17707.98
    
18.                 b = 22.217 + (L - 17700) * 8.86 / 1000 - (L - 17700) ^ 2 / (2 * 5000)
    
19.             Case Is <= 17714.68
    
20.                 b = 22.283 + (L - 17707.98) * 6.18 / 1000 - (L - 17707.98) ^ 2 / (2 * 5000)
    
21.             Case Is <= 17817.85
    
22.                 b = 22.329 + (L - 17714.68) * 6.18 / 1000
    
23.             Case Is <= 17878.3
    
24.                 b = 22.966 + (L - 17817.85) * 6.18 / 1000 + (L - 17817.85) ^ 2 / (2 * 5000)
    
25.             Case Is <= 17938.75
    
26.                 b = 22.974 + (L - 17878.3) * 18 / 1000 + (L - 17878.3) ^ 2 / (2 * 5000)
    
27.             Case Is <= 17988.953
    
28.                 b = 22.252 - (L - 17938.75) * 18 / 1000
    
29.             Case Else
    
30.                 MsgBox "超出里程范围"
    
31.         End Select
    
32.         Cells(I, 2) = b
    
33.         I = I + 1
    
34.     Loop Until Cells(I, 1) = ""
    
35. End Sub

复制代码

defnhl

学习，学习

leezhihong

你将附件上传上来，并说明要达到的效果。