说实话，不知道这样的程序还有没有实际价值？也就是说，有没有人在实际的出入库业务中使用这样的Excel程序来辅助业务？

Sub 入库录入()Dim arr, arr1, x As Integer, mydate As Date, hm As String, sr As String, sql As StringDim mydata As New Data查询mydate = [e6]: hm = [g6]If mydata.是否存在("Ruku", "入库单号码", hm) = True ThenMsgBox "已存在该入库单号码，请不要重复录入"Exit SubElsearr = 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 xMsgBox "成功录入数据库"End If
End Sub
Sub 入库查询()Dim mydata As New Data查询Dim sql As String, arr, x, yIf mydata.是否存在("Ruku", "入库单号码", [g6]) = False ThenMsgBox "该入库单号码不存在"Exit SubElseApplication.EnableEvents = FalseRange("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) - 1Cells(y + 8, x + 1) = arr(x, y)Next xNext yApplication.EnableEvents = TrueEnd If
End Sub
Sub 入库单修改()Call 入库删除Call 入库录入
End Sub
Sub 入库删除()Dim data As New Data查询, sql As StringIf data.是否存在("Ruku", "入库单号码", [g6]) = False ThenMsgBox "此入库单号码不存在"Exit SubElsesql = "Delete from Ruku where 入库单号码='" & [g6] & "'"data.执行sql命令 sqlMsgBox "已删除入库单号码为" & [g6] & "的记录"End If
End Sub
Sub 代码表存为数组()Dim data As New Data查询Dim sql As StringDim arr, ysql = "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 StringCall 代码表存为数组sr = Join(D.Keys, ",")With Range("c8:c17").Validation.Delete.Add Type:=xlValidateList, Formula1:=srEnd With
End SubSub 出库录入()Dim arr, arr1, x As Integer, mydate As Date, hm As String, sr As String, sql As StringDim mydata As New Data查询mydate = [e6]: hm = [g6]If mydata.是否存在("ChuKu", "出库单号码", hm) = True ThenMsgBox "已存在该出库单号码，请不要重复录入"Exit SubElsearr = 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 xMsgBox "成功录入数据库"End If
End Sub
Sub 出库查询()Dim mydata As New Data查询Dim sql As String, arr, x, yIf mydata.是否存在("ChuKu", "出库单号码", [g6]) = False ThenMsgBox "该出库单号码不存在"Exit SubElseApplication.EnableEvents = FalseRange("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) - 1Cells(y + 8, x + 1) = arr(x, y)Next xNext yApplication.EnableEvents = TrueEnd If
End Sub
Sub 出库单修改()Call 出库删除Call 出库录入
End Sub
Sub 出库删除()Dim data As New Data查询, sql As StringIf data.是否存在("ChuKu", "出库单号码", [g6]) = False ThenMsgBox "此入库单号码不存在"Exit SubElsesql = "Delete from ChuKu where 出库单号码='" & [g6] & "'"data.执行sql命令 sqlMsgBox "已删除出库单号码为" & [g6] & "的记录"End If
End Sub