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

Question

我目前有一个数组，该数组由列表框中的选定项目设置。我需要知道如何检查数组中是否有连续值，然后删除连续数字的最低值和最高值之间的值。

这里有一个例子来说明我的意思：

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

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

话虽这么说，如果有一种更简单的方法可以基于取消选择连续的列表框项目来做到这一点，我也很期待。

谢谢

Answer 1

使用列表框中的这些值（全部选中），您将获得：

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 个项目（甚至是空单元格）

如果 Microsoft 决定在新 Excel 版本中将网格大小增加到十亿行，则使用列表框将花费很长时间

而是总是用相应列中的使用范围填充它：

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

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

Check if array is consecutive then delete values in between vba

arrays

vba

solidworks