|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Option Explicit
Sub Auto() 'SUB子过程
Dim i&, j&, k&, m&, n&, r&, c&, tr&, tc, t 'Dim设置变量
Dim DArr, arr, brr, crr, dic, dic2, dic3, rng 'Dim设置变量这里删除了brr变量
Dim ShopName$, ShopName2$, TarShop1$, TarShop2$, PSN$, PName$ 'Dim设置变量
Dim SCnt&, MCnt&, MoveCnt&, SP#, SP2#, SPMin#, SPMax#, SPOUT, SPIN, sdate, EDate, TheDate, str$ 'Dim设置变量
t = Timer '时间
With Sheet4
sdate = .Range("sdate").Value '“Range”表示 “单元格区域” ；“"sdate"”是 变量，需要 赋值。.Value 转换为数值型
EDate = .Range("EDATE").Value
If Not IsDate(sdate) Then MsgBox "请输入开始日期!": Exit Sub '
If Not IsDate(EDate) Then MsgBox "请输入结束日期!": Exit Sub
If sdate > EDate Then MsgBox "开始日期不能大于结束日期!": Exit Sub '如果开始日期大于结束日期
SPOUT = .Range("SPOUT").Value '.Value 转换为数值型
SPIN = .Range("SPIN").Value '.Value 转换为数值型
If Not IsNumeric(SPOUT) Then MsgBox "请输入售馨率(调出)!": Exit Sub
If Not IsNumeric(SPIN) Then MsgBox "请输入售馨率(调入)!": Exit Sub
'获取数据
Application.StatusBar = "正在整理原始数据...": DoEvents
arr = .ListObjects("表2").DataBodyRange
For i = 1 To UBound(arr, 1)
ShopName = arr(i, 1)
With Worksheets(ShopName)
If .FilterMode Then .ShowAllData
r = .Cells(.Rows.Count, "b").End(xlUp).Row
m = m + r - 1
End With
Next
ReDim DArr(1 To m + 1, 1 To 18 + 1)
tr = 1
For i = 1 To UBound(arr, 1)
ShopName = arr(i, 1)
With Worksheets(ShopName)
r = .Cells(.Rows.Count, "b").End(xlUp).Row
brr = .Cells(1, 1).Resize(r, 18).Value
For j = IIf(i = 1, 1, 2) To r
DArr(tr, 1) = ShopName
For k = 1 To 18
DArr(tr, k + 1) = brr(j, k)
Next
tr = tr + 1
Next
End With
Next
'统计商品销量与库存
Application.StatusBar = "正在统计商品销量与库存...": DoEvents
Set dic = CreateObject("scripting.dictionary")
Set dic3 = CreateObject("scripting.dictionary")
For i = 2 To UBound(DArr, 1)
TheDate = DArr(i, 19)
If IsDate(TheDate) Then
TheDate = CDate(TheDate)
If TheDate >= sdate And TheDate <= EDate Then
ShopName = DArr(i, 1)
PName = DArr(i, 2)
SCnt = Val(DArr(i, 11)) '销售数量
MCnt = Val(DArr(i, 10)) '现有库存
If Not dic.exists(PName) Then
Set dic(PName) = CreateObject("scripting.dictionary")
End If
If Not dic3.exists(PName) Then
Set dic3(PName) = CreateObject("scripting.dictionary")
End If
If Not dic3(PName).exists(ShopName) Then
Set dic3(PName)(ShopName) = CreateObject("scripting.dictionary")
End If
'If PSN = "90103135" Then Stop
If dic3(PName)(ShopName)("psn") = "" Then dic3(PName)(ShopName)("psn") = DArr(i, 3) ': If PSN = "90103135" Then Stop '商品名称
If dic3(PName)(ShopName)("model") = "" Then dic3(PName)(ShopName)("model") = DArr(i, 5) '规格
If dic3(PName)(ShopName)("type") = "" Then dic3(PName)(ShopName)("type") = DArr(i, 9) '商品分类
If dic3(PName)(ShopName)("supplier") = "" Then dic3(PName)(ShopName)("supplier") = DArr(i, 18) '供应商
If dic3(PName)(ShopName)("price") = 0 And Val(DArr(i, 11)) > 0 Then dic3(PName)(ShopName)("price") = Val(DArr(i, 12)) / Val(DArr(i, 11)) '零售价
If Not dic(PName).exists(ShopName) Then
Set dic(PName)(ShopName) = CreateObject("scripting.dictionary")
dic(PName)(ShopName)("fdate") = TheDate '最早的上货日期
End If
dic(PName)(ShopName)("scnt") = dic(PName)(ShopName)("scnt") + SCnt
dic(PName)(ShopName)("mcnt") = dic(PName)(ShopName)("mcnt") + MCnt
dic(PName)(ShopName)("movecnt") = dic(PName)(ShopName)("movecnt") + 1
End If
End If
Next
'计算商品的销售率
Application.StatusBar = "正在计算商品的售罄率...": DoEvents
arr = dic.keys
For i = 0 To UBound(arr)
PName = arr(i)
brr = dic(PName).keys
For j = 0 To UBound(brr)
ShopName = brr(j)
SCnt = dic(PName)(ShopName)("scnt")
MCnt = dic(PName)(ShopName)("mcnt")
' If MCnt > 0 Then‘这个判断会丢失一些数据，因为有的库存会有负数，或者0 所以改成 If (SCnt + MCnt) > 0 Then 因为被除数不能为0
If (SCnt + MCnt) <> 0 Then
SP = SCnt / (SCnt + MCnt) ': If SP >= 0.5 Then Debug.Print PSN & " " & Format(SP, "0.00")
dic(PName)(ShopName)("sp") = SP
End If
Next
Next
'生成补货与滞销
Application.StatusBar = "正在生成补货与滞销数据...": DoEvents
Set dic2 = CreateObject("scripting.dictionary")
arr = dic.keys
For i = 0 To UBound(arr)
PName = arr(i)
If Not dic2.exists(PName) Then
Set dic2(PName) = CreateObject("scripting.dictionary")
End If
brr = dic(PName).keys
str = ""
For j = 0 To UBound(brr)
ShopName = brr(j)
SCnt = dic(PName)(ShopName)("scnt")
MCnt = dic(PName)(ShopName)("mcnt")
SP = dic(PName)(ShopName)("sp")
dic2(PName)("scnt") = dic2(PName)("scnt") + SCnt
dic2(PName)("mcnt") = dic2(PName)("mcnt") + MCnt
TheDate = dic(PName)(ShopName)("fdate")
If dic2(PName)("fdate") = "" Then dic2(PName)("fdate") = TheDate
If TheDate < dic2(PName)("fdate") Then dic2(PName)("fdate") = TheDate
'If MCnt > 0 Or SCnt > 0 Then MCNT是库存 如果加库存判断大于0 会出现数据判断失误 因为有的库存会有负数，或者0 所以改成 If SCnt > 0 Then
If (SCnt + MCnt) <> 0 Then
str = str & ShopName & ":销" & SCnt & "剩" & MCnt & "售馨率" & Format(SP, "0%")
If j < UBound(brr) Then str = str & vbNewLine
End If
Next
If (dic2(PName)("scnt") + dic2(PName)("mcnt")) <> 0 Then
dic2(PName)("sp") = dic2(PName)("scnt") / (dic2(PName)("scnt") + dic2(PName)("mcnt"))
End If
dic2(PName)("memo") = str
Next
'写入补货与滞销
Application.StatusBar = "正在写入补货与滞销结果...": DoEvents
With Sheet10
r = .Cells(.Rows.Count, 1).End(xlUp).Row
If r > 1 Then .Cells(2, 1).Resize(r - 1, 1).EntireRow.Delete
tr = 2
arr = dic2.keys
Application.ScreenUpdating = False
For i = 0 To UBound(arr)
PName = arr(i)
SP = dic2(PName)("sp")
If SP >= SPIN Or SP <= SPOUT Then
.Cells(tr, 1).Value = dic3(PName)("supplier")
.Cells(tr, 2).Value = PName
.Cells(tr, 3).Value = dic3(PName)("model")
.Cells(tr, 4).Value = dic3(PName)("type")
.Cells(tr, 5).Value = dic3(PName)("price")
.Cells(tr, 6).Value = dic2(PName)("scnt")
.Cells(tr, 7).Value = dic2(PName)("mcnt")
.Cells(tr, 8).Value = dic2(PName)("sp")
.Cells(tr, 9).Value = dic2(PName)("fdate")
.Cells(tr, 10).Value = dic2(PName)("memo")
tr = tr + 1
End If
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2022-12-8 10:57
楼主
感谢各位大佬解答
