VBA列表框更新

如何解决VBA列表框更新

我有下面的VBA代码，以不断更改设计来更新零件用户表单列表框的长列表（1000）。 我在代码所面临的以下2个问题上需要帮助， 1）以某种方式，它仅更新多选列表框下的第一个选定项。您能帮忙检查一下问题是什么，以便通过命令按钮更新所有选定的项目吗？ 另外，还有一些我也想更新的重复项。但是，下面的代码仅更新一个，而不更新其他重复项。您能帮忙更正代码，以便它也可以更新重复项吗？

Private Sub cmdaction_Click()

  Dim t,t1 As String
  Dim vrech As Range,lColumn As Range
  Dim sh As Worksheet
  Dim i As Long
  Dim selItem As String
 
  Set sh = ThisWorkbook.Sheets("part bump")
  Set lColumn = sh.Range("P1:AZA1").Find(Val(txtchangenumber.Value),xlValues,xlWhole)
  'Set lcolumn1 = sh.Range("F4:F1000")
 
  If UserForm3.txtchangedescrption.Value = "" Then
    MsgBox "Please enter Change Description"
    Exit Sub
    End If
If UserForm3.txtchangenumber.Value = "" Then
    MsgBox "Please enter Change Number"
    Exit Sub
    End If
  If UserForm3.cmbaction.Value = "" Then
    MsgBox "Please Select part Action"
    Exit Sub
    End If
 
  If lColumn Is Nothing Then
    MsgBox "Change number not found"
    Exit Sub
  End If
 
 
  With UserForm3.lstDatabase
    For i = 0 To UserForm3.lstDatabase.ListCount - 1
      If UserForm3.lstDatabase.Selected(i) = True Then
        Set vrech = sh.Range("H4:H250").Find(.Column(7,i),xlWhole)
        If Not vrech Is Nothing Then
          Select Case cmbaction.Value
            Case "RP"
              t = Chr(Asc(Mid(.List(i,7),2,1)) + 1)
               t1 = Mid(.List(i,1,2) & t & Mid(.List(i,4,1)
              Intersect(vrech.EntireRow,lColumn.EntireColumn) = t1
              MsgBox "Selected parts 'RP' Action completed"
          Case "RV"
            Intersect(vrech.EntireRow,lColumn.EntireColumn) = .List(i,7)
            MsgBox "Selected parts 'RV' Action completed"
          Case "DP"
            Intersect(vrech.EntireRow,lColumn.EntireColumn) = "Deleted"
            vrech.EntireRow.Font.Strikethrough = True
            MsgBox "Selected parts 'DP' Action completed"
        
          End Select
        End If
      End If
     
    Next i
   
  End With
End Sub

解决方法

经进一步调查，我发现您对Selected属性的处理是正确的。我已经删除了这方面的建议，并对我的仓促评论表示歉意。

我还重新检查了您的代码，很遗憾，我找不到它不能处理所有选定项的原因。无法访问您的工作簿，我无法进行测试，也无法进一步为您提供帮助。

您的第二次投诉是由这一行代码引起的。

Set vrech = sh.Range("H4:H250").Find(.Column(7,i),xlValues,xlWhole)

它将找到第一个实例，没有其他实例。如果要重复搜索，则需要循环以重复搜索。查找“ VBA Find＆FindNext MSDN”，您将找到如何构造循环的代码示例。

请注意，在Dim t,t1 As String中，只有t1是字符串。由于没有指定的数据类型，因此将t定义为变量。这似乎不是您的意图。

我还注意到您对Application.Intersect的不寻常使用。 Intersect(vrech.EntireRow,lColumn.EntireColumn)应该与简单的Sh.Cells(vrech.Row,lColumn)等效，建议在为其分配值时指定Value属性。