Sub Get_Result() Dim a As Integer Dim b As Integer Dim c As Integer Dim d As Integer Dim sum1 As Single '样本求和 Dim sum2 As Single Dim gap1 As Single '差值 Dim gap2 As Single Dim res1 As Single Dim res2 As String Dim i As Integer 'loop For i = 18 To 28 a = Sheet2.Cells(8, i).Value b = Sheet2.Cells(8, i + 1).Value c = Sheet2.Cells(9, i).Value d = Sheet2.Cells(9, i + 1).Value sum1 = a + b sum2 = c + d 'case1 If (sum1 <= 60 And sum1 >= 0 And sum2 >= 602) Or _ (sum1 >= 602 And sum2 <= 60 And sum2 >= 0) Then If a - b > 0 Then gap1 = 30 - a Else: gap1 = 30 - b End If If c - d > 0 Then gap2 = d - 300 Else: gap2 = c - 300 End If If gap1 - gap2 > 0 Then res1 = sum2 / 2 * 100 Else: res1 = sum1 / 2 * 10 End If Sheet2.Cells(10, i).Value = res1 End If 'case2 If sum1 = 0 And sum2 = 0 Then res2 = "<10" Sheet2.Cells(10, i).Value = res2 End If 'case3 If sum1 <= 60 And sum2 <= 60 Then res1 = sum1 / 2 * 10 Sheet2.Cells(10, i).Value = res1 End If 'case4 If sum1 >= 60 And sum1 <= 600 And sum2 >= 60 And sum2 <= 600 Then res1 = (sum1 + sum2) * 1000 / 22 Sheet2.Cells(10, i).Value = res1 End If 'case5 If sum1 >= 60 And sum1 <= 600 And ((sum2 <= 60 And sum2 >= 0) Or sum2 >= 600) Then res1 = sum1 / 2 * 10 Sheet2.Cells(10, i).Value = res1 ElseIf sum2 >= 60 And sum2 <= 600 And ((sum1 <= 60 And sum1 >= 0) Or sum1 >= 600) Then res1 = sum2 / 2 * 100 Sheet2.Cells(10, i).Value = res1 End If 'case6 If sum1 > 600 And sum2 > 600 Then res1 = sum2 * 2 * 100 Sheet2.Cells(10, i).Value = res1 End If i = i + 1 Next i End Sub
[此贴子已经被作者于2019-9-4 00:48编辑过]