基于VBA的Excel用户表单高级数据处理与动态交互实现

在现代商业和数据分析的广泛应用中，Excel作为一款强大的电子表格软件，其内置的VBA（Visual Basic for Applications）编程语言更是极大地扩展了其功能性和灵活性。通过VBA，用户不仅可以实现自动化的数据处理和报告生成，还能构建复杂的用户界面（UserForms），提升用户体验和数据操作的便捷性。

本文旨在探讨一种基于VBA在Excel中实现的高级数据处理与用户交互机制，特别是通过用户表单（UserForms）与数组、字典等数据结构相结合，实现数据的动态查询、筛选、编辑及删除功能。通过解析一个具体的VBA代码示例，我们将深入了解如何在Excel用户表单中设计并实现一个具有复杂数据操作能力的系统。

示例代码片段主要展示了一个用户表单，其中包含多个按钮和列表框控件，用于实现数据的筛选显示、全量显示、删除选中项以及双击列表项执行特定操作等功能。通过动态调整数组my和myy的大小和内容，代码能够高效地对存储在Excel工作表中的数据进行索引、搜索和显示，实现同时，利用字典对象dic去重，确保了列表框中显示的数据项的时间的唯一性。单击ListBox1实现数据的快速反查，完整代码片段如下：

Option Base 1
Dim my()
Private Sub CommandButton5_Click()
    Dim r As Long, j As Integer
    ListBox1.Clear
    Dim myy()
    ReDim Preserve myy(1 To 4, 1 To 1)
    myy(1, 1) = my(1, 1)
    myy(2, 1) = my(2, 1)
    myy(3, 1) = my(3, 1)
    myy(4, 1) = my(4, 1)
    n = 1: m = 0
    For i = 2 To UBound(my, 2)
    
              If my(1, i) Like "*" & TextBox1.Value & "*" Or my(2, i) Like "*" & TextBox1 & "*" Or my(3, i) Like "*" & TextBox1 & "*" Then
                n = n + 1
                m = m + 1
                ReDim Preserve myy(1 To 4, 1 To n)

                    myy(1, n) = my(1, i)
                    myy(2, n) = my(2, i)
                    myy(3, n) = my(3, i)
                    myy(4, n) = my(4, i)
            End If
    Next
     If m < 1 Then Exit Sub
     ReDim temp(1 To n, 1 To 4)
     For i = 1 To n
        For j = 1 To 4
        temp(i, j) = myy(j, i)
        Next
     Next
     
     ListBox1.List() = temp

End Sub
'
Private Sub CommandButton2_Click()
Dim temp()
ReDim temp(1 To UBound(my, 2), 1 To 4)
For i = 1 To UBound(my, 2)
   For j = 1 To 4
       temp(i, j) = my(j, i)
   Next
Next
ListBox1.List() = temp
End Sub

Private Sub CommandButton3_Click() '删单
Application.ScreenUpdating = False
Dim i1, CP_EDROW, i, k As Long
Dim cpxx
Dim r As Long
Dim n As Long
If ListBox1.ListIndex <= 0 Then Exit Sub
Call R_下单清空
CP_EDROW = Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp).Row

Dim chaDanHao As String '将选择行的第3列数据赋值给chaDanHao
Dim selectedItemIndex As Integer
    selectedItemIndex = ListBox1.ListIndex
    
    If selectedItemIndex <> -1 Then ' 确保有项目被选择
chaDanHao = ListBox1.List(selectedItemIndex, 2) ' 第3列的索引为2
   End If
   
i1 = 5
For i = 2 To CP_EDROW

If Sheet2.Cells(i, "F") = chaDanHao Then '匹配日期
Cells(i1, 2) = Sheet2.Cells(i, 1)
Cells(i1, 3) = Sheet2.Cells(i, 2)
Cells(i1, 4) = Sheet2.Cells(i, 3)
Cells(i1, 5) = Sheet2.Cells(i, 4)
Cells(i1, 6) = Sheet2.Cells(i, 5)
Cells(i1, 7) = Sheet2.Cells(i, 6)
Cells(i1, 8) = Sheet2.Cells(i, 7)
Cells(3, 2) = Sheet2.Cells(i, 8)

End If

If Sheet2.Cells(i, "F") = chaDanHao Then '增加判断，防止隔行
i1 = i1 + 1
End If
Next i
Call 增加序号

For k = Sheet2.Cells(Rows.Count, "F").End(xlUp).Row To 1 Step -1 '删除订单
    If InStr(1, Sheet2.Cells(k, "F").Value, chaDanHao, vbTextCompare) > 0 Then
        Sheet2.Rows(k).Delete Shift:=xlUp
    End If
Next k
Unload Me
Application.ScreenUpdating = True
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
Dim i1, CP_EDROW, i As Long
Dim cpxx
Dim r As Long
Dim n As Long
If ListBox1.ListIndex <= 0 Then Exit Sub
Call R_下单清空
CP_EDROW = Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp).Row

Dim chaDanHao As String '将选择行的第3列数据赋值给chaDanHao
Dim selectedItemIndex As Integer
    selectedItemIndex = ListBox1.ListIndex
    
    If selectedItemIndex <> -1 Then ' 确保有项目被选择
chaDanHao = ListBox1.List(selectedItemIndex, 2) ' 第3列的索引为2
   End If

i1 = 5
For i = 2 To CP_EDROW
If Sheet2.Cells(i, "F") = chaDanHao Then '匹配日期
Cells(i1, 2) = Sheet2.Cells(i, 1)
Cells(i1, 3) = Sheet2.Cells(i, 2)
Cells(i1, 4) = Sheet2.Cells(i, 3)
Cells(i1, 5) = Sheet2.Cells(i, 4)
Cells(i1, 6) = Sheet2.Cells(i, 5)
Cells(i1, 7) = Sheet2.Cells(i, 6)
Cells(i1, 8) = Sheet2.Cells(i, 7)
Cells(3, 2) = Sheet2.Cells(i, 8)
End If
If Sheet2.Cells(i, "F") = chaDanHao Then '增加判断，防止隔行
i1 = i1 + 1
End If
Next i
Call 增加序号
Unload Me
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
Dim temp()
Dim dic As Object
Dim key As String
w = ""
With ListBox1
.ColumnCount = 4 '设置列数
w = w & Sheet2.Cells(1, "A").Width & ";" & Sheet2.Cells(1, "B").Width & ";" & Sheet2.Cells(1, "F").Width & ";" & Sheet2.Cells(1, "H").Width & ";"
w = Left(w, Len(w) - 1)
.ColumnWidths = w
.ColumnHeads = False '是否显示列标题
A = Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp).Row
If A < 2 Then A = 2
    ReDim Preserve my(1 To 4, 1 To 1)
    my(1, 1) = Sheet2.Range("A1") '
    my(2, 1) = Sheet2.Range("B1") '
    my(3, 1) = Sheet2.Range("F1") '
    my(4, 1) = Sheet2.Range("H1") '
Set dic = CreateObject("Scripting.dictionary")
b = 1
For i = 2 To A
    key = Sheet2.Range("F" & i) '找唯一值
    If Not dic.exists(key) Then
    b = b + 1
    ReDim Preserve my(1 To 4, 1 To b)
        my(1, b) = Sheet2.Range("A" & i)
        my(2, b) = Sheet2.Range("B" & i)
        my(3, b) = Sheet2.Range("F" & i)
        my(4, b) = Sheet2.Range("H" & i)
    dic(key) = ""
    End If
Next
ReDim temp(1 To b, 1 To 4)
For i = 1 To b
   For j = 1 To 4
       temp(i, j) = my(j, i)
   Next
Next
ListBox1.List() = temp
End With
End Sub

Sub 增加序号()
Dim cell As Range
Dim n, xuhao, w As Integer
n = Range("b" & 4).End(xlDown).Row
        xuhao = 1
        For Each cell In Range("A5:A" & n) '从A4开始逐个按照1到i+1编号
        cell.Value = xuhao
        xuhao = xuhao + 1
        Next cell
End Sub

生产计划单明细：

动态演示：