代码增加限制条件

lgzxmlg

Private Sub Worksheet_Activate()
Application.DisplayAlerts = False
Rows("4:1048576").ClearContents
Set dic = CreateObject("SCRIPTING.DICTIONARY")
rng = Sheets("货品资料").[A1].CurrentRegion
For r = 2 To UBound(rng)
   Y = rng(r, 1)
   dic(Y) = rng(r, 2) & "," & rng(r, 3) & "," & rng(r, 4) & "," & rng(r, 5) & "," & rng(r, 6) & "," & rng(r, 9)
Next r
[a4].Resize(dic.Count, 1) = Application.Transpose(dic.KEYS)
[B4].Resize(dic.Count, 1) = Application.Transpose(dic.ITEMS)
[B4].Resize(dic.Count, 1).TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, COMMA:=True
Set DIC1 = CreateObject("SCRIPTING.DICTIONARY") '数量
Set DIC2 = CreateObject("SCRIPTING.DICTIONARY") '金额
rng = Sheets("入库明细").[A1].CurrentRegion
For r = 2 To UBound(rng)
   Y = rng(r, 6)
   DIC1(Y) = DIC1(Y) + rng(r, 11)
   DIC2(Y) = DIC2(Y) + rng(r, 13)
Next r
'出库明细
Set DIC3 = CreateObject("SCRIPTING.DICTIONARY") '数量
Set DIC4 = CreateObject("SCRIPTING.DICTIONARY") ' 金额
rng = Sheets("出库明细").[A1].CurrentRegion
For r = 2 To UBound(rng)
   Y = rng(r, 7)
   DIC3(Y) = DIC3(Y) + rng(r, 12)
   DIC4(Y) = DIC4(Y) + rng(r, 14)
Next r
TARR = [A1].CurrentRegion
For r = 4 To UBound(TARR)
   Y = TARR(r, 1)
   TARR(r, 9) = DIC1(Y)
     TARR(r, 10) = DIC2(Y)
       TARR(r, 11) = DIC3(Y)
     TARR(r, 12) = DIC4(Y)
Next r
[A1].CurrentRegion = TARR
[H4].Resize(dic.Count, 1).Formula = "=F4*G4"
[M4].Resize(dic.Count, 1).Formula = "=G4+I4-K4"
[N4].Resize(dic.Count, 1).Formula = "=F4*M4"
[O4].Resize(dic.Count, 1).Formula = "=L4+N4-J4-H4"
[g2].Formula = "=SUBTOTAL(9,G4:G65536)"
[h2].Formula = "=SUBTOTAL(9,H4:H65536)"
[i2].Formula = "=SUBTOTAL(9,I4:I65536)"
[J2].Formula = "=SUBTOTAL(9,J4:J65536)"
[K2].Formula = "=SUBTOTAL(9,K4:K65536)"
[L2].Formula = "=SUBTOTAL(9,L4:L65536)"
[M2].Formula = "=SUBTOTAL(9,M4:M65536)"
[N2].Formula = "=SUBTOTAL(9,N4:N65536)"
[O2].Formula = "=SUBTOTAL(9,O4:O65536)"
Range("a4").Select
Application.DisplayAlerts = True
End Sub

以上代码想加个日期限制。开始日期放在ks = Sheets("库存统计").Range("R1")，结束日期放在js = Sheets("库存统计").Range("T1")。表格中日期都在表格的A列。如何修改代码？请老师帮忙解决。 增加条件.zip (162.29 KB, 下载次数: 6)

2023-2-11 11:12 上传

点击文件名下载附件

3190496160

上传附件，具体描述你目前的代码逻辑或者说描述你的需求，没有人会话很多时间和精力去研究你的代码，从而理解你的需求的，再者，单纯研究代码，也没法完全了解你的需求的

lgzxmlg

3190496160 发表于 2023-2-11 11:03
上传附件，具体描述你目前的代码逻辑或者说描述你的需求，没有人会话很多时间和精力去研究你的代码，从而理 ...

已添加附件，请帮忙，谢谢。

lgzxmlg

各位老师，看看我的问题。谢谢

shiruiqiang

新手。两个for 循环后面，这里都是rng：
For r = 2 To UBound(rng)，  if rng(r,1)>=ks and rng(r,1)<=js then

准提部林

Worksheet_Activate
每次選取工作表就跑一次程序, 不累嗎???

lgzxmlg

准提部林 发表于 2023-2-11 14:49
Worksheet_Activate
每次選取工作表就跑一次程序, 不累嗎???

只要能完成，就简单了。请帮忙。谢谢

准提部林

lgzxmlg 发表于 2023-2-11 15:50
只要能完成，就简单了。请帮忙。谢谢

指定日期區間...那庫存就不準確了---
原代碼沒有列入期初餘額, 怎算出本期???

將統計流程完整說明, 也許原代碼並不正確~~

lgzxmlg

准提部林 发表于 2023-2-11 17:31
指定日期區間...那庫存就不準確了---
原代碼沒有列入期初餘額, 怎算出本期???

思路：根据【货品资料】中【A】列的货品编码与【入库明细表】中【F】列的货品编码，进行对照计算出各编码的个数与金额。再根据日期限制将【出库明细】中【G】列的货品编码个数和金额计算进来。两者相减得出结果填入到【库存统计】各列中。不知可否实现。谢谢老师帮忙。
【入库明细表】与【出库明细】 中的货品编码都是从【货品资料】中来。全部是对应的。入、出增加截止日期。

准提部林

必須處理四個工作表//代碼較多//自行調適
Xl0000490.rar (63.87 KB, 下载次数: 5)

2023-2-12 14:45 上传

点击文件名下载附件