Question

我目前正在使用VBA为Solidworks编写宏。此宏设置一个数组，其中包含注释的x，y和arctan位置。然后我想使用bubblesort方法对数组进行排序。该数组是一个单维数组，它首先设置x值，然后是y，然后是arctan。如果有9个音符，那么0-8是x值，9-17是y值，18-26是arctan。这是我遇到问题的地方。我需要选择排序使用的范围。

arrlen = arrlen - 1
ReDim Preserve vloc(arrlen - 1)
BubbleSort1 vloc
arrlen1 = arrlen1 - 1
ReDim Preserve vloc(arrlen To arrlen1)
BubbleSort1 vloc

上面是我调用各种类型的代码。 arrlen和arrlen1是每个值的总备注的计数器。

我在第二次调出时得到一个超出范围错误的脚本。

我不反对重写数组的初始设置和对多维数组的排序，但我不知道如何正确地做到这一点。

下面是我设置数组的代码。

Set swFirstNote = swView.GetFirstNote
Set swNote = swView.GetFirstNote
ReDim notes(notesTotalCounter)
ReDim vloc(notesTotalCounter)
i = 0
arrlen = 0
While Not swNote Is Nothing
    If swNote.GetText Like "`*" Then
        Set swAnno = swNote.GetAnnotation
        loc = swAnno.GetPosition
        Dim t As Double
        Dim x As Double
        Dim y As Double
        x = loc(0)
        y = loc(1)
        t = ArcTan2(cpX - loc(0), cpY - loc(1))
        vloc(i) = x
        i = i + 1
        arrlen = arrlen + 1
    End If
    Set swNote = swNote.GetNext
Wend

Set swFirstNote = swView.GetFirstNote
Set swNote = swView.GetFirstNote
ReDim Preserve vloc(notesTotalCounter)
i = arrlen
arrlen1 = arrlen
While Not swNote Is Nothing
    If swNote.GetText Like "`*" Then
        Set swAnno = swNote.GetAnnotation
        ReDim Preserve vloc(i)
        loc = swAnno.GetPosition
        x = loc(0)
        y = loc(1)
        t = ArcTan2(cpX - loc(0), cpY - loc(1))
        vloc(i) = y
        i = i + 1
        arrlen1 = arrlen1 + 1
    End If
    Set swNote = swNote.GetNext
Wend

非常感谢任何帮助。

Answer 1

这是我最近写的一些内容，用于按字母顺序对一系列培训科目进行排序。从该子例程返回后，我将数组加载到组合框中。培训科目按优先级顺序列在工作表的一行中，从单元格 C2 到左侧。培训科目的数量因可以在不同时间添加和删除而有所不同。这是被调用以创建全局数组 strSubject() 以传递给 Userform Activate 事件以填充组合框的子例程。

您应该能够了解排序例程背后的基本思想，并将其调整为您的代码。因为我的所有记录都是文本，所以我使用波浪号 (~) 来确保第二个数组按字母顺序填充下一个可用记录。当您使用数字时，您可能希望将代码中的波浪号替换为小于数据中任何可能值的数字，因此如果最低值为 1，则将比较器设为 -1。如果您的最低可能值是 -i,ooo,ooo,ooo，请使您的比较器低于该值。如果您不确定，请运行第三个例程以找到数据数组中的最小值，减去 1 并将该值设为比较器值。

Sub Create_Alphabetical_Subject_List()

Dim f As Integer
Dim x As Integer: x = 1
Dim y As Integer: y = 1
Dim strTempSubject() As String

Set wss = ThisWorkbook.Sheets("Internal Training Matrix")
varSubjectCount = WorksheetFunction.CountA(Worksheets("Internal Training Matrix").Range("C2", Worksheets("Internal Training Matrix").Range("C2").End(xlEnd)))

ReDim varSortedFlag(varSubjectCount)
ReDim varSorted(varSubjectCount)
ReDim strTempSubject(varSubjectCount)
ReDim strSubject(varSubjectCount)

For x = 1 To varSubjectCount
    If wss.Cells.Item(2, x + 2) <> "" And wss.Cells.Item(2, x + 2) <> "Spare" Then
        strTempSubject(x) = wss.Cells.Item(2, x + 2) ' From row 2 col 3 initially
        varSorted(x) = "~"
        varSortedFlag(x) = ""
    End If
Next x

For y = 1 To varSubjectCount
    For x = 1 To varSubjectCount
        If varSortedFlag(x) = "" And strTempSubject(x) < varSorted(y) Then
            varSorted(y) = strTempSubject(x)    ' Swap out a lower value
            f = x   ' Track which record was last copied to new array
        End If
    Next x
    strSubject(y) = varSorted(y)
    varSortedFlag(f) = "Done" ' Remove the record from future comparrisons
Next y

结束子

通过选择出现vba对数组进行排序

1 个答案: