Link excel 中的列表框和工作表要删除 - VBA

Link Listbox and sheets in excel for delete - VBA

我在 excel 中使用 VBA 用户表单创建列表框。它的值是从Excel中的Sheet获得的。 如何在删除框列表项时删除 sheet "database" 中的值? 请帮助我。

Private Sub UserForm_Initialize()
Dim ws      As Worksheet
Dim rng     As Range

Dim MyArray 
Set ws = Sheets("Database")

Set rng = ws.Range("K2:L" & ws.Range("K" & ws.Rows.Count).End(xlUp).Row)

With Me.ListBox1
.Clear
.ColumnHeads = False
.ColumnCount = rng.Columns.Count

 MyArray = rng

.List = MyArray

.ColumnWidths = "90;90"
.TopIndex = 0
End With
End Sub

Private Sub CommandButton2_Click()
For lItem = Me.ListBox1.ListCount - 1 To 0 Step -1
    If ListBox1.Selected(lItem) Then
        ListBox1.RemoveItem lItem
        If Me.ListBox1.MultiSelect = fmMultiSelectSingle Then
            Exit For
        End If
    End If
Next
End Sub

ListBox 中删除项目之前,您需要使用 ListBox.Selected 中的定位值从 "database" 中查找并删除项目。

像这样:

Private Sub CommandButton2_Click()
  For lItem = Me.ListBox1.ListCount - 1 To 0 Step -1
    If ListBox1.Selected(lItem) Then
        DeleteItemFromDatabase ListBox1.Selected(lItem).Value
        ListBox1.RemoveItem lItem
        If Me.ListBox1.MultiSelect = fmMultiSelectSingle Then
          Exit For
        End If
    End If
  Next
End Sub

然后您的 Sub DeleteItemFromDatabase(ByVal itemToDelete As [type]) 会在您的 "database" 中找到 itemToDelete 并将其删除。

另外请注意,您可能需要考虑使用 Access 作为数据库,因为它实际上是为一个数据库而设计的。我知道这并不总是可行的,但我想我会把它扔在那里作为对你的想法。

如何删除 sheet "database" 中的值?

当您通过数组方法分配数据库项时(不使用 ControlSource),您想知道如何在手动删除后将列表框项与数据库同步。

方法 A) - 写出整个 Listbox1.List

如果你想要在 For- Next 循环之后的列表框项目的镜像,你可以简单地将这些项目写回给定的范围(当然你应该清除 'surplus rows',也)通过以下 one liner

    rng.Resize(Me.ListBox1.ListCount, 2) = Me.ListBox1.List

与其在 CommandButton2_Click 中重复数据范围声明,我建议在用户窗体代码模块的声明头中声明一次(并且 省略 它在 Userform_Initialize):

完整代码如下:

Additional notes due to comment

将这两行代码插入到用户窗体代码模块的 top 中(以及 before 任何过程)。

Option Explicit 在任何代码中都被严格推荐以强制声明变量类型(但你不能像你那样在 Sub 中使用此语句)。声明 Dim rng As Range 在其他过程之外(即在顶部)允许此代码模块中的任何过程 知道 rng 变量。

Option Explicit               ' declaration head of the UserForm module
Dim rng as Range              ' ONE database declaration only!
                              ' << OUTSIDE of following procedures 
' << Start of regular procedures                              
Private Sub UserForm_Initialize()
Dim ws      As Worksheet
' Dim rng   As Range    ' << not needed here, see top declaration
Dim MyArray
Set ws = Sheets("Database")
Set rng = ws.Range("K2:L" & ws.Range("K" & ws.Rows.Count).End(xlUp).Row)
With Me.ListBox1
    .Clear
    .ColumnHeads = False
    .ColumnCount = rng.Columns.Count

     MyArray = rng

    .List = MyArray
    .ColumnWidths = "90;90"
    .TopIndex = 0
End With
End Sub

Private Sub CommandButton3_Click()   
Dim lItem&
For lItem = Me.ListBox1.ListCount - 1 To 0 Step -1
    If ListBox1.Selected(lItem) Then
        ListBox1.RemoveItem lItem           ' remove item from listbox
        If Me.ListBox1.MultiSelect = fmMultiSelectSingle Then
            Exit For
        End If
    End If
Next

rng.Offset(Me.ListBox1.ListCount, 0).Resize(rng.Rows.Count, 2) = "" ' clear rows
rng.Resize(Me.ListBox1.ListCount, 2) = Me.ListBox1.List             ' write list back

End Sub

注意没有行被物理删除,两个目标列K:L中的结果列表框项目仅向上移动(方法B允许也删除整行).

方法 B) - 主循环中的帮助程序

使用用户窗体声明头中的相同数据范围声明 ► 如上所示(即在程序外部作为 Subs 或 Functions),您可以使用帮助程序 DelData 允许区分两种主要情况:

  • [1] 上移数据库中已删除的单元格
  • [2] 删除整行

事件过程 CommandButton2_Click

Private Sub CommandButton2_Click()
' Purpose: delete items both from database and listbox
Dim lItem&
For lItem = Me.ListBox1.ListCount - 1 To 0 Step -1
    If ListBox1.Selected(lItem) Then
        DelData lItem, True     ' [1] True=delete items and shift up
       'DelData lItem, False    ' [2] False=delete entire row

        ListBox1.RemoveItem lItem           ' remove item from listbox
        If Me.ListBox1.MultiSelect = fmMultiSelectSingle Then
           Exit For                ' do it once in single select case
        End If
    End If
Next
End Sub

帮助程序DelData

Sub DelData(ByVal indx&, Optional ByVal bShiftUp As Boolean = True)
' Purpose: delete indicated row items in database
' Note:    data set in OP includes header
    If bShiftUp Then    ' [1] bShiftUp = True: delete row items and shift up
       rng.Offset(indx).Resize(1, rng.Columns.Count).Delete xlShiftUp
    Else                ' [2] bShiftUp = False: delete entire row of indicated items
       rng.Offset(indx).Resize(1, rng.Columns.Count).EntireRow.Delete
    End If
End Sub

旁注

建议完全限定范围引用以避免从错误的工作簿中获取数据,因此我建议在您的 UserForm_Initialize 过程中使用以下语句:

Set ws = ThisWorkbook.Worksheets("Database")

尽情享受吧:-)