哪位帮我看看，该如何优化，谢谢了

szj612

以下是我写的用于统计圆的程式，把相同规格的圆分别统计
只能统计5种规格的直径和5种规格的color,现在我想改为更多规格，能不能用循环解决？能不能不限规格？
谢谢！


Public Sub TEST() '测试用

Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("dsdgds")
sset.SelectOnScreen
Dim Ent As AcadEntity
Dim A As Long
Dim I(1, 5) As Long     '5种不同的直径，其余都归于第6种,计数和记录值各用一维
Dim J(1, 5, 5) As Long    '对应不同直径的5种不同的COLOR，其余都归于第6种,计数和记录值各用一维
For Each Ent In sset
2:
Select Case CLng(Ent.Diameter)
Case I(0, 0)
    I(1, 0) = I(1, 0) + 1
    Select Case Ent.color
    Case J(0, 0, 0)
        J(1, 0, 0) = J(1, 0, 0) + 1
    Case J(0, 0, 1)
        J(1, 0, 1) = J(1, 0, 1) + 1
    Case J(0, 0, 2)
        J(1, 0, 2) = J(1, 0, 2) + 1
    Case J(0, 0, 3)
        J(1, 0, 3) = J(1, 0, 3) + 1
    Case J(0, 0, 4)
        J(1, 0, 4) = J(1, 0, 4) + 1
    Case Else
        If J(0, 0, 0) = 0 Then
            J(0, 0, 0) = Ent.color
            GoTo 2:
        ElseIf J(0, 0, 1) = 0 Then
            J(0, 0, 1) = Ent.color
            GoTo 2
        ElseIf J(0, 0, 2) = 0 Then
            J(0, 0, 2) = Ent.color
            GoTo 2
        ElseIf J(0, 0, 3) = 0 Then
            J(0, 0, 3) = Ent.color
            GoTo 2
        ElseIf J(0, 0, 4) = 0 Then
            J(0, 0, 4) = Ent.color
            GoTo 2
        Else
            J(1, 0, 5) = J(1, 0, 5) + 1
        End If
    End Select
Case I(0, 1)
    I(1, 1) = I(1, 1) + 1
    Select Case Ent.color
    Case J(0, 1, 0)
        J(1, 1, 0) = J(1, 1, 0) + 1
    Case J(0, 1, 1)
        J(1, 1, 1) = J(1, 1, 1) + 1
    Case J(0, 1, 2)
        J(1, 1, 2) = J(1, 1, 2) + 1
    Case J(0, 1, 3)
        J(1, 1, 3) = J(1, 1, 3) + 1
    Case J(0, 1, 4)
        J(1, 1, 4) = J(1, 1, 4) + 1
    Case Else
        If J(0, 1, 0) = 0 Then
            J(0, 1, 0) = Ent.color
            GoTo 2:
        ElseIf J(0, 1, 1) = 0 Then
            J(0, 1, 1) = Ent.color
            GoTo 2
        ElseIf J(0, 1, 2) = 0 Then
            J(0, 1, 2) = Ent.color
            GoTo 2
        ElseIf J(0, 1, 3) = 0 Then
            J(0, 1, 3) = Ent.color
            GoTo 2
        ElseIf J(0, 1, 4) = 0 Then
            J(0, 1, 4) = Ent.color
            GoTo 2
        Else
            J(1, 1, 5) = J(1, 1, 5) + 1
        End If
    End Select
Case I(0, 2)
    I(1, 2) = I(1, 2) + 1
    Select Case Ent.color
    Case J(0, 2, 0)
        J(1, 2, 0) = J(1, 2, 0) + 1
    Case J(0, 2, 1)
        J(1, 0, 1) = J(1, 2, 1) + 1
    Case J(0, 2, 2)
        J(1, 2, 2) = J(1, 2, 2) + 1
    Case J(0, 2, 3)
        J(1, 2, 3) = J(1, 2, 3) + 1
    Case J(0, 2, 4)
        J(1, 2, 4) = J(1, 2, 4) + 1
    Case Else
        If J(0, 2, 0) = 0 Then
            J(0, 2, 0) = Ent.color
            GoTo 2:
        ElseIf J(0, 2, 1) = 0 Then
            J(0, 2, 1) = Ent.color
            GoTo 2
        ElseIf J(0, 2, 2) = 0 Then
            J(0, 2, 2) = Ent.color
            GoTo 2
        ElseIf J(0, 2, 3) = 0 Then
            J(0, 2, 3) = Ent.color
            GoTo 2
        ElseIf J(0, 2, 4) = 0 Then
            J(0, 2, 4) = Ent.color
            GoTo 2
        Else
            J(1, 2, 5) = J(1, 2, 5) + 1
        End If
    End Select
Case I(0, 3)
    I(1, 3) = I(1, 3) + 1
    Select Case Ent.color
    Case J(0, 3, 0)
        J(1, 3, 0) = J(1, 3, 0) + 1
    Case J(0, 3, 1)
        J(1, 3, 1) = J(1, 3, 1) + 1
    Case J(0, 3, 2)
        J(1, 3, 2) = J(1, 3, 2) + 1
    Case J(0, 3, 3)
        J(1, 3, 3) = J(1, 3, 3) + 1
    Case J(0, 3, 4)
        J(1, 3, 4) = J(1, 3, 4) + 1
    Case Else
        If J(0, 3, 0) = 0 Then
            J(0, 3, 0) = Ent.color
            GoTo 2:
        ElseIf J(0, 3, 1) = 0 Then
            J(0, 3, 1) = Ent.color
            GoTo 2
        ElseIf J(0, 3, 2) = 0 Then
            J(0, 3, 2) = Ent.color
            GoTo 2
        ElseIf J(0, 3, 3) = 0 Then
            J(0, 3, 3) = Ent.color
            GoTo 2
        ElseIf J(0, 3, 4) = 0 Then
            J(0, 3, 4) = Ent.color
            GoTo 2
        Else
            J(1, 3, 5) = J(1, 3, 5) + 1
        End If
    End Select
Case I(0, 4)
    I(1, 4) = I(1, 4) + 1
    Select Case Ent.color
    Case J(0, 4, 0)
        J(1, 4, 0) = J(1, 4, 0) + 1
    Case J(0, 4, 1)
        J(1, 4, 1) = J(1, 4, 1) + 1
    Case J(0, 4, 2)
        J(1, 4, 2) = J(1, 4, 2) + 1
    Case J(0, 4, 3)
        J(1, 4, 3) = J(1, 4, 3) + 1
    Case J(0, 4, 4)
        J(1, 4, 4) = J(1, 4, 4) + 1
    Case Else
        If J(0, 4, 0) = 0 Then
            J(0, 4, 0) = Ent.color
            GoTo 2:
        ElseIf J(0, 4, 1) = 0 Then
            J(0, 4, 1) = Ent.color
            GoTo 2
        ElseIf J(0, 4, 2) = 0 Then
            J(0, 4, 2) = Ent.color
            GoTo 2
        ElseIf J(0, 4, 3) = 0 Then
            J(0, 4, 3) = Ent.color
            GoTo 2
        ElseIf J(0, 4, 4) = 0 Then
            J(0, 4, 4) = Ent.color
            GoTo 2
        Else
            J(1, 4, 5) = J(1, 4, 5) + 1
        End If
    End Select
Case Else
    If I(0, 0) = 0 Then
        I(0, 0) = CLng(Ent.Diameter)
        GoTo 2
    ElseIf I(0, 1) = 0 Then
        I(0, 1) = CLng(Ent.Diameter)
        GoTo 2
    ElseIf I(0, 2) = 0 Then
        I(0, 2) = CLng(Ent.Diameter)
        GoTo 2
    ElseIf I(0, 3) = 0 Then
        I(0, 3) = CLng(Ent.Diameter)
        GoTo 2
    ElseIf I(0, 4) = 0 Then
        I(0, 4) = CLng(Ent.Diameter)
        GoTo 2
    Else
        I(1, 5) = I(1, 5) + 1
    End If
End Select
Next
Dim op As Variant                         '输出结果
op = ThisDrawing.Utility.GetPoint
Dim txt As AcadText
For M = 0 To 5
    For N = 0 To 5
        If J(1, M, N) > 0 Then
            Set txt = ThisDrawing.ModelSpace.AddText(J(1, M, N) & "-" & I(0, M) & "*" & J(0, M, N), op, 4)
            op(1) = op(1) - 6
        End If
    Next N
Next M
sset.Delete
End Sub

wwswwswws

把圆的直径、颜色和ID写入数据库，然后用SQL语言建立一个查询完全可以不用这么麻烦而达到你的要求。

szj612

谢谢楼上，因为编程只是业余爱好，所以还不懂怎么操作数据库，我想知道，如果不用数据库，有没有好的算法？不限规格有困难的话，可以限定规格，实际上规格（直径）和子规格（颜色）不会超过15。
这个程式所要解决的现实示例是：在一张总图中，包含许多个螺丝，因为螺丝是标准件，所以大小规格（直径）不是很多，但同一大小又可能存在多种长度（程式中以颜色代替），我想列出清单，把相同规格的螺丝汇总。

mccad

找找排序的函数，然后建立数组，将圆的直径、颜色、句柄等信息组合成多维数组。
通过数组中的某一维元素进行排序，排序后你就知道怎么处理了。
排序过程设成独立的函数，这样你想处理多少数据都可以。

szj612

谢谢明总，我明白了思路，估计在原理上和数据库也差不多，我试试看。