VBA按深度、类别分类统计，截取定长算法。

勘察收费标准，按岩土类别和深度共有54档收费基价，深度9档，岩土等级6类，下面的代码是解决这个问题的核心算法。

While d1 < d2
Select Case d1
Case Is < 10
If d2 <= 10 Then
th = d2 - d1 ''厚度
d1 = d2 ''起点=端点，结束
Else
th = 10 - d1
d1 = 10
End If
SD = “10”
Case Is < 20
If d2 <= 20 Then
th = d2 - d1
d1 = d2
Else
th = 20 - d1
d1 = 20
End If
SD = “20”
Case Is < 30
If d2 <= 30 Then
th = d2 - d1
d1 = d2
Else在这里插入代码片
th = 30 - d1
d1 = 30
End If
SD = “30”
Case Is < 40
If d2 <= 40 Then
th = d2 - d1
d1 = d2
Else
th = 40 - d1
d1 = 40
End If
SD = “40”
Case Is < 50
If d2 <= 50 Then
th = d2 - d1
d1 = d2
Else
th = 50 - d1
d1 = 50
End If
SD = “50”
Case Is < 60
If d2 <= 60 Then
th = d2 - d1
d1 = d2
Else
th = 60 - d1
d1 = 60
End If
SD = “60”
Case Is < 80
If d2 <= 80 Then
th = d2 - d1
d1 = d2
Else
th = 80 - d1
d1 = 80
End If
SD = “80”
Case Is < 100
If d2 <= 100 Then
th = d2 - d1
d1 = d2
Else
th = 100 - d1
d1 = 100
End If
SD = “100”
Case Else
th = d2 - d1
d1 = d2
SD = “100+”
End Select

              CX = LB & "*" & SD    '' Ⅳ*80   Ⅳ*100  Ⅳ*100+ Ⅴ*10   Ⅴ*20   Ⅴ*30

              k = 3
              
              While SheetB.Cells(3, k) <> CX And SheetB.Cells(3, k) <> ""
                  k = k + 1
              Wend
              
              If SheetB.Cells(3, k) = "" Then      ''很奇怪，没找到!
                 MsgBox "没找到相应的类别！" & strKH & ", " & CX
                 Exit Sub
              End If
              
              SheetB.Cells(n + 3, k) = SheetB.Cells(n + 3, k) + th     ''相同类别要累加
                            
       Wend   '' While d1 < d2