完善表格内容

Laughingsun889

老师们下午好！表格的代码只能完成部分工作。请老师们施以援手，运行代码后完善表格内容。要求见样本表格。谢谢！

Laughingsun889

已解决日期和产品信息，重编号、删除空行未解决，期待援手！谢谢！

ykcbf1100

主要是没看懂。不知道应该做什么。

lln0618

自行添加行删除的代码吧  

hs = Range("B1048576").End(xlUp).Row '获取B列最后一行行号
For i = hs To 2 Step -1  '行删除
If Range("F" & i) = "" Then 'F列如果有空单元格
Rows(i).Delete
End If
Next

Laughingsun889

ykcbf1100 发表于 2024-5-9 11:09
主要是没看懂。不知道应该做什么。

解决按日期生成领料清单。生成的清单中，有些内容不完善，如各清单中最后一列中有空行，能否在生成清单时删除该日期清单的空行，并重新编写序号。谢谢老师的回复。

lln0618

Laughingsun889 发表于 2024-5-9 11:24
解决按日期生成领料清单。生成的清单中，有些内容不完善，如各清单中最后一列中有空行，能否在生成清单时 ...

A列序号直接用公式 =ROW(B5)-4  

ykcbf1100

Laughingsun889 发表于 2024-5-9 11:24
解决按日期生成领料清单。生成的清单中，有些内容不完善，如各清单中最后一列中有空行，能否在生成清单时 ...

新工作簿是按日期来命名的吗？

ykcbf1100

附件供参考。。。

ykcbf1100

代码新写一个。

1. Sub ykcbf() '//2024.5.9
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Application.ScreenUpdating = False '关闭屏幕刷新
   
4.     Application.DisplayAlerts = False
   
5.     p = ThisWorkbook.Path & ""
   
6.     Dim tm: tm = Timer
   
7.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
8.     With sh
   
9.         r = .Cells(Rows.Count, 1).End(xlUp).Row
   
10.         col = .UsedRange.Columns.Count
    
11.         arr = .[a1].Resize(r, col)
    
12.         dm = .[b2].Value
    
13.     End With
    
14.     For j = 12 To UBound(arr, 2)
    
15.         s = Format(arr(4, j), "m月d日")
    
16.         d(s) = ""
    
17.     Next
    
18.     For Each k In d.keys
    
19.         sh.Copy
    
20.         Set wb = ActiveWorkbook
    
21.         With wb.Sheets(1)
    
22.             .Name = k
    
23.             .DrawingObjects.Delete
    
24.             .[g:az].Delete
    
25.             .[a1] = "物料清单"
    
26.             .[a3] = "物料日期："
    
27.             .[f4] = "领用数量"
    
28.             .[b3] = k
    
29.             .[c3].Resize(1, 4) = ""
    
30.             .UsedRange.Offset(4).Clear
    
31.             m = 0
    
32.             ReDim brr(1 To UBound(arr), 1 To 6)
    
33.             For j = 12 To UBound(arr, 2)
    
34.                 If Format(arr(4, j), "m月d日") = k Then c = j
    
35.             Next
    
36.             For i = 5 To UBound(arr)
    
37.                 If arr(i, c) <> Empty Then
    
38.                     m = m + 1
    
39.                     brr(m, 1) = m
    
40.                     For j = 2 To 5
    
41.                         brr(m, j) = arr(i, j)
    
42.                     Next
    
43.                     brr(m, 6) = arr(i, c)
    
44.                 End If
    
45.             Next
    
46.             .[a5].Resize(m, 6) = brr
    
47.         End With
    
48.         wb.SaveAs p & dm & "领料" & "-" & k
    
49.         wb.Close 1
    
50.     Next
    
51.     Set d = Nothing
    
52.     Application.ScreenUpdating = True '开启屏幕刷新
    
53.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
54. End Sub
    

复制代码

longwin

Laughingsun889 发表于 2024-5-9 10:55
已解决日期和产品信息，重编号、删除空行未解决，期待援手！谢谢！

重编号、删除空行，请按照图片中红框位置插入对应语句试试。

1.                 For j = .[A4].End(xlDown).Row To 5 Step -1  '删除数量为空的行
   
2.                     If .Cells(j, 6) = "" Then
   
3.                     .Rows(j).Delete
   
4.                     End If
   
5.                 Next
   
6.                
   
7.                 For j = .[A4].End(xlDown).Row To 5 Step -1  '重写序号
   
8.                     .Cells(j, 1) = j - 4
   
9.                 Next

复制代码