利用VBA实现购物清单

窗体结构：
工作表目录：
产品信息sheet1：
订单记录sheet2：
商品信息sheet3：
实现代码：

Dim arr()
Dim ID As String
Dim DJ As Long

Private Sub CommandButton1_Click()

If Me.ListBox1.Value <> "" And Me.ListBox1.Value <> "" And Me.ListBox1.Value <> "" And Me.TextBox1 > 0 Then

    Me.ListBox4.AddItem
    Me.ListBox4.List(Me.ListBox4.ListCount - 1, 0) = ID
    Me.ListBox4.List(Me.ListBox4.ListCount - 1, 1) = Me.ListBox1.Value
    Me.ListBox4.List(Me.ListBox4.ListCount - 1, 2) = Me.ListBox2.Value
    Me.ListBox4.List(Me.ListBox4.ListCount - 1, 3) = Me.ListBox3.Value
    Me.ListBox4.List(Me.ListBox4.ListCount - 1, 4) = Me.TextBox1.Value
    Me.ListBox4.List(Me.ListBox4.ListCount - 1, 5) = Me.TextBox1.Value * Me.Label2.Caption
Else
MsgBox "请正确选择商品！！！"
End If
Me.Label5.Caption = Me.Label5.Caption + Me.TextBox1.Value * Label2.Caption


End Sub

Private Sub CommandButton2_Click()
For i = 0 To Me.ListBox4.ListCount - 1
    If Me.ListBox4.Selected(i) = True Then
        Me.Label5.Caption = Me.Label5.Caption - Me.ListBox4.List(i, 5)
        Me.ListBox4.RemoveItem i
    End If
Next

    
End Sub

Private Sub CommandButton3_Click()
Dim DDID As String
Dim i
If Me.ListBox4.ListCount > 0 Then

    i = Sheet2.Range("a65536").End(xlUp).Row + 1
    DDID = "D" & Format(VBA.Now, "yyyymmddhhmmss")
    
    For j = 0 To ListBox4.ListCount - 1
        Sheet2.Range("a" & i) = DDID
        Sheet2.Range("b" & i) = Data
        Sheet2.Range("c" & i) = Me.ListBox4.List(j, 0)
        Sheet2.Range("d" & i) = Me.ListBox4.List(j, 4)
        Sheet2.Range("e" & i) = Me.ListBox4.List(j, 5)
        i = i + 1
    Next

        MsgBox "结算成功！"

Else

    MsgBox "购物清单为空的！"

End If

End Sub

Private Sub ListBox1_Click()

Dim dic
Set dic = CreateObject("Scripting.Dictionary")
Me.ListBox2.Clear

For i = LBound(arr) To UBound(arr)
    If arr(i, 2) = Me.ListBox1.Value Then
        dic(arr(i, 3)) = 1
    End If
Next

Me.ListBox2.List = dic.keys
Me.ListBox3.Clear
Me.Label2.Caption = 0

End Sub

Private Sub ListBox2_Click()

Dim dic
Me.ListBox3.Clear
Set dic = CreateObject("Scripting.Dictionary")

For i = LBound(arr) To UBound(arr)
    If arr(i, 2) = Me.ListBox1.Value And arr(i, 3) = Me.ListBox2.Value Then
        dic(arr(i, 4)) = 1
    End If
Next

Me.ListBox3.List = dic.keys
Me.Label2.Caption = 0

End Sub

Private Sub ListBox3_Click()

For i = LBound(arr) To UBound(arr)
    If arr(i, 2) = Me.ListBox1.Value And arr(i, 3) = Me.ListBox2.Value And arr(i, 4) = Me.ListBox3.Value Then
        ID = arr(i, 1)
        DJ = arr(i, 5)
    End If
Next

Me.Label2.Caption = DJ

End Sub

Private Sub ListBox4_Click()

End Sub

Private Sub UserForm_Activate()
Dim dic
arr = Sheet1.Range("a2:e" & Sheet1.Range("a65536").End(xlUp).Row) '数组中的每一行都循环,在表格中对应位置增加项目，可自动更新
Set dic = CreateObject("Scripting.Dictionary")

For i = LBound(arr) To UBound(arr)
    dic(arr(i, 2)) = 1 '每一行的第二列拿过来放在数组中做key
Next

Me.ListBox1.List = dic.keys
End Sub
操作结果展示：
利用VBA实现购物清单

猜你喜欢
