代码之家 › 专栏 › 技术社区 › bieringm

检查数组是否连续,然后删除vba之间的值

solidworks vba arrays

bieringm · 技术社区 · 8 年前

下面是一个例子来说明我的意思:

Dim sheets() As Long
Dim Selected As String

ReDim sheets(i)
For i = 1 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
        Selected = ListBox1.List(i)
        ReDim Preserve sheets(i)
        sheets(i) = Selected
    End If
Next i

该数组用于设置打印页范围的Solidworks API函数。这就是为什么我不能有超过2个连续的数字。

这就是说,如果有一个更简单的方法来做到这一点的基础上取消选择连续的列表框项目,我也洗耳恭听。

非常感谢。

1 回复 | 直到 8 年前

paul bica 8 年前

通过列表框中的这些值(全部选中),您可以获得:

ListBox  Result -> Array(1, 3, 5, 7, 9, 11)
   1        1
   3        3
   4  
   5        5
   7        7
   8  
   9        9
  11       11

Option Explicit

Public Sub GetMinMaxOfConsecutives()
    Dim sheets() As Long, i As Long, totalItms As Long
    Dim prev As Boolean, nxt As Boolean, used As Long, this As Long

    used = 1
    With ListBox1    'Sheet1.ListBox1
        totalItms = .ListCount - 1
        ReDim sheets(1 To totalItms)
        For i = 1 To totalItms - 1
            If .Selected(i) Then
                this = .List(i)
                prev = IIf(.Selected(i - 1), this - 1 <> .List(i - 1), True)
                nxt = IIf(.Selected(i + 1), this + 1 <> .List(i + 1), True)
                If prev Or nxt Then
                    sheets(used) = this
                    used = used + 1
                End If
            End If
        Next
        If .Selected(i) Then sheets(used) = .List(i) Else used = used - 1
        If used > 0 Then ReDim Preserve sheets(1 To used) Else ReDim sheets(0)
        'ShowArray sheets
    End With
End Sub

Private Sub ShowArray(ByRef arr() As Long)
    Dim i As Long
    For i = LBound(arr) To UBound(arr)
        Debug.Print arr(i)
    Next
End Sub

编辑:

要将不属于序列的项加倍,请确保增加初始数组大小以适应这种情况:

ListBox  Result -> Array(1, 1, 3, 3, 5, 5, 7, 7, 9, 9)
   1
   3
   5
   7
   9

Public Sub GetMinMaxOfConsecutives2()
    Dim sheets() As Long, i As Long, totalItms As Long
    Dim prev As Boolean, nxt As Boolean, used As Long, this As Long

    used = 1
    With ListBox1
        totalItms = .ListCount - 1

        ReDim sheets(1 To totalItms * 2 + 1)    '<-- double upper bound

        For i = 1 To totalItms - 1
            If .Selected(i) Then
                this = .List(i)

                prev = IIf(.Selected(i - 1), this - 1 <> .List(i - 1), True)
                nxt = IIf(.Selected(i + 1), this + 1 <> .List(i + 1), True)

                If prev Or nxt Then
                    If prev And nxt Then
                        sheets(used) = this
                        used = used + 1
                    End If
                    sheets(used) = this
                    used = used + 1
                End If

            End If
        Next

        If .Selected(i) Then sheets(used) = .List(i) Else used = used - 1
        If used > 0 Then ReDim Preserve sheets(1 To used) Else ReDim sheets(0)
        'ShowArray sheets

    End With
End Sub

如果您使用 ListFillRange "A:A" 因为这将向列表中添加1+M个项目(甚至是空单元格)

如果微软决定在新的Excel版本中将网格大小增加到10亿行,使用列表框将需要很长时间

相反,始终使用各个列中的已用范围填充它:

ListBox1.ListFillRange = Sheet1.UsedRange.Columns(1).Address