汇总库存数据是，总把第一行预留的区域覆盖掉

alanlad

各位老师好


我最近拼凑一个库存汇总表，【每日库存量】为总表，在里面点击【更新库存】后会自动将文件中中其他5个库存文件自动汇总到【每日库存量】这个表里
因为每次列表会变，就在第一行做了个判断列标的公式。

现在我点击【更新库存】后，数据会覆盖掉第一行的数据导致公式出错

哪位老师帮我看下代码，哪里出了问题，覆盖掉第一行

库存更新.zip (963.21 KB, 下载次数: 9)

2024-9-19 10:10 上传

点击文件名下载附件

ykcbf1100

按理说，这类汇总很简单啊，但看你代码写得有点复杂。

alanlad

ykcbf1100 发表于 2024-9-19 10:41
按理说，这类汇总很简单啊，但看你代码写得有点复杂。

我是网上荡的，东拼西凑

ykcbf1100

alanlad 发表于 2024-9-19 10:50
我是网上荡的，东拼西凑

新写一个，供参考。。。

公式去掉了，用代码替换

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.9.19
   
2.     Application.ScreenUpdating = False
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set sh = ThisWorkbook.Sheets("即时库存")
   
6.     Dim tm: tm = Timer
   
7.     With sh
   
8.         c = .Cells(2, "XFD").End(1).Column
   
9.         For j = 1 To 51
   
10.             s = .Cells(2, j)
    
11.             d(s) = j
    
12.         Next
    
13.         num = Val(.[bd2].Value)
    
14.     End With
    
15.     ReDim brr(1 To 100000, 1 To 100)
    
16.     p = ThisWorkbook.Path & ""
    
17.     For Each f In fso.GetFolder(p).Files
    
18.         If LCase$(f.Name) Like "*.xls*" Then
    
19.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
20.                 fn = fso.GetBaseName(f)
    
21.                 Set Wb = Workbooks.Open(f, 0)
    
22.                 With Wb.Sheets(1)
    
23.                     arr = .UsedRange
    
24.                     For i = 2 To UBound(arr)
    
25.                         If Val(arr(i, 1)) Then
    
26.                             m = m + 1
    
27.                             For j = 1 To UBound(arr, 2)
    
28.                                 s = arr(1, j)
    
29.                                 If d.exists(s) Then
    
30.                                     brr(m, d(s)) = arr(i, j)
    
31.                                 End If
    
32.                             Next
    
33.                         End If
    
34.                         brr(m, 52) = f.Name
    
35.                         brr(m, 53) = .Name
    
36.                         brr(m, 55) = Left(brr(m, 1), 3)
    
37.                         k = CDate(brr(m, 41)) - CDate(Date)
    
38.                         If brr(m, 41) = Empty Then brr(m, 54) = "正常库存"
    
39.                         Select Case k
    
40.                             Case Is > num
    
41.                                 brr(m, 54) = "正常库存"
    
42.                             Case Is < 0
    
43.                                 brr(m, 54) = "过期库存"
    
44.                             Case Else
    
45.                                 brr(m, 54) = "临保库存"
    
46.                         End Select
    
47.                     Next
    
48.                 End With
    
49.                 Wb.Close False
    
50.             End If
    
51.         End If
    
52.     Next f
    
53.     With sh
    
54.         .UsedRange.Offset(2).ClearContents
    
55.         .[a3].Resize(m, 55) = brr
    
56.     End With
    
57.     Set d = Nothing
    
58.     Application.ScreenUpdating = True
    
59.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
60. End Sub
    

复制代码