碼上歡樂
相關內容    簡體    繁體

VBA-字典與用戶界面設計+ACCESS系統開發

本文轉載自   查看原文   2020-05-06 10:55   681    excell操作及VBA編程學習記錄

1，字典：就是一個數組 只有兩列

作用：去重復

 

  使用字典首先得勾選工具中的

然后才可以使用

Sub test2()
Dim dic As New Dictionary
dic.Add "張三", 3000
dic.Add "李四", 2000
dic("李四") = 8000
Range("a10") = dic("李四")
End Sub

循環添加，但是這個方法有個問題，就是如果有重復的key值，程序就會崩潰

Sub test2()
Dim dic As New Dictionary
For i = 2 To 4
    dic.Add Range("d" & i).Value, Range("e" & i).Value
Next

End Sub

這種方式可以進行值得更改，避免因重復更導致程序崩潰

Sub test2()
Dim dic As New Dictionary
dic("張三") = 4000
dic("李四") = 3000
dic("李四") = 8000
Range("a10") = dic("李四")
End Sub

利用上面的方法，進行優化，可以去重復，但李四最后的值是8000

Sub test2()
Dim dic As New Dictionary
For i = 2 To 5
    dic(Range("d" & i).Value) = Range("a" & i).Value
Next

MsgBox dic.Count    '驗證
Range("a15:d15") = dic.Keys '驗證
End Sub

使用單元格賦值，很明顯比較麻煩，因此這里可以使用數組來

Sub test2()
Dim dic As New Dictionary
Dim arr()
arr = Range("d2:e5")
For i = 1 To 4
    dic(arr(i, 1)) = arr(i, 2)
Next

MsgBox dic.Count    '驗證
Range("a15:d15") = dic.Key '驗證
End Sub

2， 門店銷售記錄

 

 

 工程

 

 

 

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

Private Sub CommandButton1_Click()
If Me.ListBox1.Value <> "" And Me.ListBox2.Value <> "" And Me.ListBox3.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 * Me.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 Me.ListBox4.ListCount - 1
        Sheet2.Range("a" & i) = DDID
        Sheet2.Range("b" & i) = Date
        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 "結算成功"
    Unload Me
Else
    MsgBox "購物清單為空"
End If
End Sub
-------------------------------------------------------------------
Private Sub ListBox1_Click()
Dim dic
'arr = Sheet1.Range("a2:e" & Sheet1.Range("a65536").End(xlUp).Row)
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
Next
Me.ListBox1.List = dic.keys
End Sub

 

 

 

 

 

 

Private Sub CommandButton1_Click()
UserForm1.Show
End Sub

3，ACCESS系統開發

通過上面的銷售制作，在每次添加數據后，久而久之，文件會變得很大，且如果收銀台有兩個，那么必須的有兩張表，最后再進行合並數據，那么這就用到了ACCESS

將上面excel版的銷售記錄更改為access版

1）將產品信息放在access里面

 

 2）更改下代碼，在每次打開excel之前抓取access里面產品信息里的數據

 

 

Private Sub Workbook_Open()
Dim conn As New ADODB.Connection
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\data\data.accdb"
Sheet1.Range("a2").CopyFromRecordset conn.Execute("select * from [產品信息]")

conn.Close

End Sub

userform1里面的代碼也需要更改，僅更改arr 取值范圍就可以了，其余代碼和上面相同

Private Sub UserForm_Activate()
Dim dic
arr = Sheet1.Range("b2:f" & Sheet1.Range("a65536").End(xlUp).Row)
Set dic = CreateObject("Scripting.Dictionary")
For i = LBound(arr) To UBound(arr)
    dic(arr(i, 2)) = 1
Next
Me.ListBox1.List = dic.keys
End Sub

3）然后有新的產品直接在access里面添加，在打開excel之后數據被抓取進去

 4）完整版access版銷售記錄

Private Sub Workbook_Open()
Dim conn As New ADODB.Connection
Sheet1.Range("a2:f1000").ClearContents

conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\data\data.accdb"
Sheet1.Range("a2").CopyFromRecordset conn.Execute("select * from [產品信息]")

conn.Close

End Sub

 

 

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

Private Sub CommandButton1_Click()
If Me.ListBox1.Value <> "" And Me.ListBox2.Value <> "" And Me.ListBox3.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 * Me.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 conn As New ADODB.Connection
Dim str As String


If Me.ListBox4.ListCount > 0 Then
    DDID = "D" & Format(VBA.Now, "yyyymmddhhmmss")
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\data\data.accdb"
    For i = 0 To Me.ListBox4.ListCount - 1
    '    str = "('" & DDID & "','" & Date & "','" & Me.ListBox4.List(0, 0) & "'," & Me.ListBox4.List(0, 4) & "," & Me.ListBox4.List(0, 5) & ")"
        str = "('" & DDID & "','2020/5/7','" & Me.ListBox4.List(i, 0) & "'," & Me.ListBox4.List(i, 4) & "," & Me.ListBox4.List(i, 5) & ")"
        conn.Execute ("insert into [銷售記錄](訂單號,日期,產品編號,數量,金額) values" & str)
    Next
    conn.Close
    MsgBox "結算成功"
    Unload Me
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 UserForm_Activate()
Dim dic
arr = Sheet1.Range("b2:f" & Sheet1.Range("a65536").End(xlUp).Row)
Set dic = CreateObject("Scripting.Dictionary")
For i = LBound(arr) To UBound(arr)
    dic(arr(i, 2)) = 1
Next
Me.ListBox1.List = dic.keys
End Sub

 


免責聲明！

本站轉載的文章為個人學習借鑒使用，本站對版權不負任何法律責任。如果侵犯了您的隱私權益，請聯系本站郵箱yoyou2525@163.com刪除。



猜您在找 Web開發人員不要錯過的60款用戶界面設計工具（上） vba-用戶圖形界面 Java-第15章圖形用戶界面設計例題 【軟劍攻城隊】用戶界面設計原型文檔發布！ VBA-利用字典代替VLOOKUP Odoo 12開發之后台視圖 – 設計用戶界面 ### 小菜的系統框架界面設計-序言 Android Studio安卓學習筆記(三)Android用戶界面的設計布局與組件(一)用戶界面布局設計(1) Unity3D GUI圖形用戶界面系統 Android開發入門教程--4.用戶界面之Layout(一)
 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM