Question

我现在道歉，因为我是一个绝对的初学者（也是我的图片和代码天堂已被推广）。

我在Excel中有一个下拉列表框，由我在excel内部选择的范围填充（即在放置后右键单击ActiveX控件并更改属性）。我希望如果选择列表中的某些项目，则会从列表中删除其他项目，以便无法选择它们。例如。有一个列表A，B和C，但是当用户选择A时，B将从列表中消失。

我的代码如下。第一部分编码下拉列表

Sub Rectangle1_Click()

Dim SelShp As Shape, ListShp As Shape, SelList As Variant, i As Integer

Set SelShp = Sheet8.Shapes(Application.Caller)
Set ListBx = Sheet8.ListBox1

If SelShp.TextFrame2.TextRange.Characters.Text = "Select Buffers" Then
    ListBx.Visible = True
    SelShp.TextFrame2.TextRange.Characters.Text = "Set Buffers"
Else
    ListBx.Visible = False
    SelShp.TextFrame2.TextRange.Characters.Text = "Select Buffers"
    For i = 0 To Sheet8.ListBox1.ListCount - 1
        If Sheet8.ListBox1.Selected(i) = True Then
           SelList = SelList & "; " & Sheet8.ListBox1.List(i)
        End If
    Next i
    If SelList <> "" Then
        Range("ListBox1Output") = Right(SelList, Len(SelList) - 1)
    Else
        Range("ListBox1Output") = ""
    End If
End If

End Sub

第二个代码是应该从列表中删除项目

Private Sub ListBox1_Change()

If Sheet8.ListBox1.Selected(0) Then
    Sheet8.ListBox1.RemoveItem 1
End If

End Sub

问题是，当我尝试时，我得到一个运行时错误＆＃39; -2147467259（80004005）＆＃39;：未指定的错误。，如果我尝试调试它突出显示＆＃39; Sheet8.ListBox1.RemoveItem 1＆＃39;，但我不知道我知道自己做错了什么。任何帮助都会非常感激，如果我错过了一些非常简单的事情，我很抱歉。

编辑：自从我发布以来，我一直在研究这个问题，并找到了一些解决方案，但遇到了其他障碍。

我的第一个问题是.RemoveItem方法没有做任何事情。事实证明，如果使用.ListFillRange方法填充ListBox，.RemoveItem将无法工作 - 如果我以后想要.RemoveItem，则必须使用.AddItem填充ListBox。

在我解决这个问题之后，我决定尝试用更简单的数据做我想做的事情：

我有2个列表框，我用数据填充其中一个。在ListBox1中选择一个项目后，该项目将被复制到ListBox2中，并从ListBox1中删除。此外，如果选择了ListBox1中的某些项目，则会从列表框中删除其他项目，以便无法选择它们。例如。有一个列表A，B和C，但是当用户选择A时，B将从列表中消失。

我的代码已经达到某些情况下的效果。不幸的是，项目的顺序很重要，并且出于某种原因，对于某些项目序列，代码不能按预期工作 - 例如我的通用项目恰好是：德国，印度，法国，美国，英国。选择＆＃39;德国＆＃39;，此项目出现在ListBox2中，它将从ListBox1中删除，而且，＆＃39; France＆＃39;从ListBox1中删除。这项工作正常，直到项目按字母顺序排列，此时选择＆＃39;德国＆＃39;，此项目出现在ListBox2中，它将从ListBox1中删除，＆＃39; France＆＃39;从ListBox1中删除，并将印度和美国移入ListBox2 ......好像曾经的法国＆＃39;已被删除，选择它下面的任何内容并由于某种原因运行ListBox1_Change（）子的前2个循环。使用消息框中断它是有原因的，但我无法在不使用消息框的情况下解决它...

我的代码如下，对我尝试包含的内容有一些评论。

使用随机位置的项目填充ListBox1

Sub Populate_ListBox1()

'Clear LB1 before populating it
Sheet1.ListBox1.Clear
Sheet1.ListBox2.Clear

Sheet1.ListBox1.AddItem "Germany"
Sheet1.ListBox1.AddItem "India"
Sheet1.ListBox1.AddItem "France"
Sheet1.ListBox1.AddItem "USA"
Sheet1.ListBox1.AddItem "England"

End Sub

尝试在更改ListBox1中的项目时移动选定的ListBox1项目

Private Sub ListBox1_Change()

'Variable Declaration
Dim iCnt As Integer
Dim jCnt As Integer
Dim kCnt As Integer

'Move Selected Item from Listbox1 to Listbox2
For iCnt = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(iCnt) = True Then
        Me.ListBox2.AddItem Me.ListBox1.List(iCnt)
    End If
Next

'Clear Selected Item from Listbox1
For iCnt = Me.ListBox1.ListCount - 1 To 0 Step -1
    If Me.ListBox1.Selected(iCnt) = True Then
        Me.ListBox1.RemoveItem iCnt
        'Me.ListBox1.Selected(iCnt) = False 'Nope
        'Exit For
    End If
Next

'If Germany is in Listbox2, then remove France from LB1
For kCnt = 0 To Me.ListBox2.ListCount - 1
    If Me.ListBox2.Column(0, kCnt) = "Germany" Then
        For jCnt = 0 To Me.ListBox1.ListCount - 1
            If Me.ListBox1.Column(0, jCnt) = "France" Then
                Me.ListBox1.RemoveItem jCnt
                'Me.ListBox1.Locked = True 'Nope
                'Me.ListBox1.Enabled = False 'Nope
                'Me.ListBox1.ListIndex = -1 'This crashes excel...
                'MsgBox "blah" 'For some reason this works >.<
                Exit Sub
            End If
        Next jCnt
    End If
Next

End Sub

我非常感谢这方面的帮助，甚至会建议使用与excel一起使用的其他程序（尝试根据索引更改列表框中的项目，更改，而不是他们的价值观是一场噩梦）

使用excel-vba

0 个答案: