报歉,上传附件时忘了把代码附上了。- Option Explicit
- Dim artest As Variant
- Dim artbl(1 To 174, 1 To 1) As Variant
- Dim lngrow As Long
- Sub test() '测试
- Dim dtyear As Date
- Dim lngmaxrow As Long
-
- ReDim artest(1 To 173, 1 To 6)
- dtyear = #1/5/2014#
-
- With ThisWorkbook.Worksheets("Sheet1")
- lngmaxrow = .UsedRange.Rows.Count
- artest = .Range("A2:F" & lngmaxrow)
- End With
-
- For lngrow = 1 To UBound(artest)
-
- UpdateArray 2, 3, 4, 5, 6
-
- If CDate(Format(artest(lngrow, 4), "0000/00/00")) <= dtyear Then
-
- UpdateArray 8, 9, 10, 11, 12
-
- Select Case artest(lngrow, 2)
- Case Is <= 35
- UpdateArray 20, 21, 22, 23, 24
- Case Is <= 40
- UpdateArray 26, 27, 28, 29, 30
- Case Is <= 45
- UpdateArray 32, 33, 34, 35, 36
- Case Is <= 50
- UpdateArray 38, 39, 40, 41, 42
- Case Is <= 70
- UpdateArray 44, 45, 46, 47, 48
- Case Is <= 90
- UpdateArray 50, 51, 52, 53, 54
- Case Is < 100
- UpdateArray 56, 57, 58, 59, 60
- Case Is >= 45 And artest(lngrow, 2) < 100
- UpdateArray 62, 63, 64, 65, 66
- Case Is >= 50 And artest(lngrow, 2) < 100
- UpdateArray 68, 69, 70, 71, 72
- Case Is >= 50 And artest(lngrow, 2) < 150
- UpdateArray 74, 75, 76, 77, 78
- Case Is >= 60 And artest(lngrow, 2) < 100
- UpdateArray 80, 81, 82, 83, 84
- Case Is >= 70 And artest(lngrow, 2) < 100
- UpdateArray 86, 87, 88, 89, 90
- Case Is >= 50 And artest(lngrow, 2) < 500
- UpdateArray 92, 93, 94, 95, 96
- Case Is >= 100 And artest(lngrow, 2) < 500
- UpdateArray 98, 99, 100, 101, 102
- Case Is >= 100 And artest(lngrow, 2) < 300
- UpdateArray 104, 105, 106, 107, 108
- Case Is >= 300 And artest(lngrow, 2) < 500
- UpdateArray 110, 111, 112, 113, 114
- Case Is >= 100
- UpdateArray 116, 117, 118, 119, 120
- Case Is >= 500
- UpdateArray 122, 123, 124, 125, 126
- Case Is >= 500 And artest(lngrow, 2) < 1000
- UpdateArray 128, 129, 130, 131, 132
- Case Is >= 1000
- UpdateArray 134, 135, 135, 137, 138
- End Select
- Else
-
- UpdateArray 14, 15, 16, 17, 18
-
- Select Case artest(lngrow, 2)
- Case Is <= 15
- UpdateArray 140, 141, 142, 143, 144
- Case Is <= 20
- UpdateArray 146, 147, 148, 149, 150
- Case Is > 20
- UpdateArray 152, 153, 154, 155, 156
- Case Is >= 35
- UpdateArray 158, 159, 160, 161, 162
- End Select
-
- End If
- Next lngrow
- End Sub
- Sub UpdateArray(ParamArray indices())
- artbl(indices(0), 1) = artbl(indices(0), 1) + artest(lngrow, 2)
- artbl(indices(1), 1) = artbl(indices(1), 1) + artest(lngrow, 3)
- If artest(lngrow, 5) > 0 Then
- artbl(indices(2), 1) = artbl(indices(2), 1) + artest(lngrow, 2)
- Else
- artbl(indices(3), 1) = artbl(indices(3), 1) + artest(lngrow, 2)
- End If
- If artest(lngrow, 6) = 0 Then
- artbl(indices(4), 1) = artbl(indices(4), 1) + artest(lngrow, 3)
- End If
- End Sub
复制代码 |