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

该数组用于设置打印图纸范围的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个以上的项目到列表（甚至空单元格）

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

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

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

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

1 个答案: