access vba 进销存进销存vba代码

转载

detailtoo 2024-04-29 23:20:36

文章标签 access vba 进销存 sql Data 进销存 文章分类 架构后端开发

还记得15年前，帮别人买过一个名叫“管家婆”的进销存软件，也不知道用的怎么样？

Public D As New Dictionary
Sub 入库录入()
  Dim arr, arr1, x As Integer, mydate As Date, hm As String, sr As String, sql As String
  Dim mydata As New Data查询
   mydate = [e6]: hm = [g6]
   If mydata.是否存在("Ruku", "入库单号码", hm) = True Then
   MsgBox "已存在该入库单号码，请不要重复录入"
   Exit Sub
 Else
  arr = Range("c8:g" & Range("f18").End(xlUp).Row)
  
  For x = 1 To UBound(arr)
   sr = "#" & mydate & "#" & ",'" & hm & "','" & arr(x, 1) & "','" & arr(x, 2) & "',"
   sr = sr & arr(x, 3) & "," & arr(x, 4) & "," & arr(x, 5)
   sql = "Insert into ruku (入库日期, 入库单号码, 商品代码,商品名称,入库数量,入库单价,入库金额) VALUES(" & sr & ")"
   mydata.执行sql命令 (sql)
  Next x
  MsgBox "成功录入数据库"
 End If
End Sub
Sub 入库查询()
  Dim mydata As New Data查询
  Dim sql As String, arr, x, y
  If mydata.是否存在("Ruku", "入库单号码", [g6]) = False Then
   MsgBox "该入库单号码不存在"
   Exit Sub
  Else
  Application.EnableEvents = False
  Range("c8:f17") = ""
   sql = "select * from RuKu where 入库单号码='" & [g6] & "'"
   arr = mydata.筛选结果(sql)
   [e6] = arr(0, 0)
   For y = 0 To UBound(arr, 2)
     For x = 2 To UBound(arr) - 1
       Cells(y + 8, x + 1) = arr(x, y)
     Next x
   Next y
    Application.EnableEvents = True
  End If
End Sub
Sub 入库单修改()
  Call 入库删除
  Call 入库录入
End Sub
Sub 入库删除()
 Dim data As New Data查询, sql As String
 If data.是否存在("Ruku", "入库单号码", [g6]) = False Then
   MsgBox "此入库单号码不存在"
   Exit Sub
 Else
   sql = "Delete from Ruku where 入库单号码='" & [g6] & "'"
   data.执行sql命令 sql
   MsgBox "已删除入库单号码为" & [g6] & "的记录"
 End If
End Sub
Sub 代码表存为数组()
  Dim data As New Data查询
  Dim sql As String
  Dim arr, y
  sql = "Select * from 代码表"
  arr = data.筛选结果(sql)
  For y = 1 To UBound(arr, 2)
    D(arr(0, y)) = arr(1, y) & "-" & arr(2, y)
  Next y
End Sub
Sub 生成下拉()
   Dim sr As String
   Call 代码表存为数组
   sr = Join(D.Keys, ",")
    With Range("c8:c17").Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=sr
    End With
End Sub

Sub 出库录入()
  Dim arr, arr1, x As Integer, mydate As Date, hm As String, sr As String, sql As String
  Dim mydata As New Data查询
   mydate = [e6]: hm = [g6]
   If mydata.是否存在("ChuKu", "出库单号码", hm) = True Then
   MsgBox "已存在该出库单号码，请不要重复录入"
   Exit Sub
 Else
  arr = Range("c8:g" & Range("f18").End(xlUp).Row)
  
  For x = 1 To UBound(arr)
   sr = "#" & mydate & "#" & ",'" & hm & "','" & arr(x, 1) & "','" & arr(x, 2) & "',"
   sr = sr & arr(x, 3) & "," & arr(x, 4) & "," & arr(x, 5)
   sql = "Insert into ChuKu (销售日期, 出库单号码, 商品代码,商品名称,销售数量,销售单价,销售金额) VALUES(" & sr & ")"
   mydata.执行sql命令 (sql)
  Next x
  MsgBox "成功录入数据库"
 End If
End Sub
Sub 出库查询()
  Dim mydata As New Data查询
  Dim sql As String, arr, x, y
  If mydata.是否存在("ChuKu", "出库单号码", [g6]) = False Then
   MsgBox "该出库单号码不存在"
   Exit Sub
  Else
  Application.EnableEvents = False
  Range("c8:f17") = ""
   sql = "select * from ChuKu where 出库单号码='" & [g6] & "'"
   arr = mydata.筛选结果(sql)
   [e6] = arr(0, 0)
   For y = 0 To UBound(arr, 2)
     For x = 2 To UBound(arr) - 1
       Cells(y + 8, x + 1) = arr(x, y)
     Next x
   Next y
    Application.EnableEvents = True
  End If
End Sub
Sub 出库单修改()
  Call 出库删除
  Call 出库录入
End Sub
Sub 出库删除()
 Dim data As New Data查询, sql As String
 If data.是否存在("ChuKu", "出库单号码", [g6]) = False Then
   MsgBox "此入库单号码不存在"
   Exit Sub
 Else
   sql = "Delete from ChuKu where 出库单号码='" & [g6] & "'"
   data.执行sql命令 sql
   MsgBox "已删除出库单号码为" & [g6] & "的记录"
 End If
End Sub


Sub 入库明细查询()
 Dim mydata As New Data查询
 Dim sql As String
 sql = "Select * from Ruku"
 mydata.执行筛选 sql, "a2"
End Sub
Sub 入库明细查询2()
 Dim mydata As New Data查询
 Dim sql As String
 sql = "Select * from Ruku Where  Month(入库日期)=1 And 商品代码='3001'"
 mydata.执行筛选 sql, "a2"
End Sub

Sub 出库明细查询()
 Dim mydata As New Data查询
 Dim sql As String
 sql = "Select * from Chuku"
 mydata.执行筛选 sql, "a2"
End Sub
Sub 出库明细查询2()
 Dim mydata As New Data查询
 Dim sql As String
 sql = "Select * from ChuKu Where  Month(销售日期)=1 And 商品代码='3001'"
 mydata.执行筛选 sql, "a2"
End Sub

Sub 入库汇总查询()
 Dim mydata As New Data查询
 Dim sql As String
 Range("a1:d1") = Array("商品名称", "入库数量", "入库单价", "入库金额")
 sql = "Select 商品名称,sum(入库数量),first(入库单价),sum(入库金额) from RuKu Where  Month(入库日期)=2 group by 商品名称"
 mydata.执行筛选 sql, "a2"
End Sub
Sub 生成本月进销存()
Dim mydata As New Data查询
Dim sql As String, sql1 As String, sql2 As String, sql3 As String, sql4 As String, sql5 As String, sql6 As String, sql7 As String
'1 因为进销存表中是入库和出库的都是汇总数，所以首先对本月入库(sql1)和本月出库(sql2)进行汇总.
sql1 = "Select 商品名称,商品代码,sum(入库数量) as 入数汇总,sum(入库金额) as 入金汇总 from ruku where month(入库日期)=" & [k1] & " group by 商品名称,商品代码"
sql2 = "Select 商品名称,商品代码,sum(销售数量) as 销数汇总,sum(销售金额) as 销金汇总 from chuku where month(销售日期)=" & [k1] & " group by 商品名称,商品代码"
'2 要想方便的算出期初数量，我们可以用“期初=库存数-本月入+本月出”的公式推算出期初数
   '下面三个SQL语句是完成库存表的生成 ,即:库存数(sql5)=总的入库(sql3)-总的出库(sql4)
sql3 = "Select 商品名称,商品代码,sum(入库数量) as 总入 from ruku where month(入库日期)<=" & [k1] & " group by 商品名称,商品代码"
sql4 = "Select 商品名称,商品代码,sum(销售数量) as 总出 from Chuku where month(销售日期)<=" & [k1] & " group by 商品名称,商品代码"
sql5 = "select 入库.商品名称 as 商品名称,入库.商品代码 as 商品代码,(入库.总入-出库.总出) as 库存数 from (" & sql3 & ") as 入库 left join (" & sql4 & ") as 出库 on 入库.商品代码=出库.商品代码"
'3 库存表有了,下面首先合并库存表和入库表,让库存数减去入库数
sql6 = "Select 库存.商品名称 AS 商品名称,库存.商品代码 as 商品代码,(库存.库存数-iif(isnull(入库.入数汇总),0,入库.入数汇总)) AS 期初数1,入库.入数汇总 AS 入库数量,入库.入金汇总 as 入库金额,库存.库存数 as 库存数 from (" & sql5 & ") as 库存 left join (" & sql1 & ") as 入库 on 库存.商品代码=入库.商品代码"
'4 最后一步,把上一步合并后的表再加上本月出库,期初库存就被完美倒推出来了.
sql7 = "Select 库存.商品名称 AS 商品名称,库存.商品代码 as 商品代码,库存.期初数1+iif(isnull(出库.销数汇总),0,出库.销数汇总),库存.入库数量,库存.入库金额,出库.销数汇总,出库.销金汇总,库存.库存数 as 库存数 from (" & sql6 & ") as 库存 left join (" & sql2 & ") as 出库 on 库存.商品代码=出库.商品代码"
mydata.执行筛选 sql7, "A2"
End Sub

本文章为转载内容，我们尊重原作者对文章享有的著作权。如有内容错误或侵权问题，欢迎原作者联系我们进行内容更正或删除文章。