如何进一步压缩此代码?

时间:2016-02-02 14:44:03

标签: excel excel-vba vba

在下面的代码中,我将4个不同列中的值与预定义值进行比较,并返回名为“size”的列中最高行的值。是否有更好的方法使用数组编写此代码?

Sub CalculatetierJP()

Dim i, n, lth, wth, ht, wt, dwt, tier, flth, fwth, fht, fwt, ftier, dmwt As Integer

i = 2
n = 1
lth = 33
wth = 34
ht = 35
wt = 28
dwt = 36
tier = 37
GL = 17


Cells(1, 37) = "Size"
Cells(1, 50) = "Non-media/Media"
Cells(1, 51) = "Final tier"
Cells(1, 52) = "flth"
Cells(1, 53) = "fwth"
Cells(1, 54) = "fht"
Cells(1, 55) = "fwt"
Cells(1, 56) = "ftier"

' 1-Small
' 2- Standard
' 3- Oversize
' 4- Heavy Bulky

Do While Not Cells(i, n).Value = ""

If Cells(i, 7).Value = "y" Then

  'Set all to zero
   flth = 0
   fwth = 0
   fht = 0
   fwt = 0
   ftier = 0
'''**********************************
''Calcualte the tier based on length
'''**********************************

If Cells(i, lth) < 30.48 Then
    flth = 1

ElseIf Cells(i, lth) >= 30.48 And Cells(i, lth) < 50.48 And Cells(i, wt) < 12000 Then
    flth = 2

ElseIf Cells(i, lth) >= 30.48 And Cells(i, lth) < 50.48 And Cells(i, wt) >= 12000 Then
    flth = 3

End If

Cells(i, 52).Value = flth

'''**********************************
''Calcualte the tier based on width
'''**********************************
If Cells(i, wth) < 20.32 Then
    fwth = 1

ElseIf Cells(i, wth) >= 20.32 And Cells(i, wth) < 40.64 And Cells(i, wt) < 12000 Then
    fwth = 2

ElseIf Cells(i, wth) >= 20.32 And Cells(i, wth) < 40.64 And Cells(i, wt) >= 12000 Then
    fwth = 3

End If

Cells(i, 53).Value = fwth
'''**********************************
''Calcualte the tier based on height
'''**********************************
If Cells(i, ht) < 10.16 Then
    fht = 1

ElseIf Cells(i, ht) >= 10.16 And Cells(i, ht) < 25.4 And Cells(i, wt) < 12000 Then
    fht = 2

ElseIf Cells(i, ht) >= 10.16 And Cells(i, ht) < 25.4 And Cells(i, wt) >= 12000 Then
    fht = 3

Cells(i, 54).Value = fht

End If
'''**********************************
'''Calcualte the tier based on weight
'''**********************************

If Cells(i, wt) < 1000 Then
    fwt = 1

ElseIf Cells(i, wt) >= 1000 And Cells(i, wt) < 12000 Then
    fwt = 2

ElseIf Cells(i, wt) >= 12000 Then
    fwt = 3

End If

Cells(i, 55).Value = fwt

'''**********************************
'''Calcualte the final tier
'''ftier = Max(flth, fwth, fht)
'''**********************************

ActiveWorkbook.Worksheets("audit").Activate
'Set myrange = Worksheets("audit").Range("AV2:AX2")
ftier = Application.WorksheetFunction.Max(flth, fwth, fht, fwt)
Cells(1, 56).Value = ftier

' 1-Small
' 2- Standard
' 3- Oversize
' 4- Heavy Bulky

If ftier = 1 Then
    Cells(i, 37) = "small"

ElseIf ftier = 2 Then
    Cells(i, 37) = "standard"

ElseIf ftier = 3 Then
    Cells(i, 37) = "oversize"

ElseIf ftier = 0 Then
    Cells(i, 37) = "Did not calculate"

End If

Cells(i, 39).Value = Cells(i, 47).Value

End If
Dim row1 As Integer

row1 = ActiveSheet.UsedRange.Rows.Count

For i = 2 To row1

i = i + 1

Next i

Loop

End Sub

1 个答案:

答案 0 :(得分:0)

您的问题是您的代码在最后增加i计数变量。第一个问题是您要递增两次:一次在i=i+1上,一次在Next i上。另一个问题是,在for循环中,你只是运行所有使用的范围。要解决此问题,您需要删除for循环并保留i=i+1