查看代码并修改代码

施学明

原需求：1、将下拨明细表复制到配钞明细中

          2、将配钞明细表中合计金额为0所在行删除，序号连续
          3、将表2内容按打印模版打印输出
          4、保存本工作簿，并将工作表“配钞明细”和“打印模版”删除，另存其他文件夹以当前日期加“下拨明细”命名的工作簿

shiruiqiang

机构和机构号做字典，提取“l”列>0的字典

施学明

附件已上传，不好意思

ykcbf1100

求助要求有点怪怪的。
另存文件夹是啥名呢？

施学明

下拨明细文件夹

ykcbf1100

复制代码已经完成以下功能（删除行和序号代码可以不用了）：
工作表复制、删除0值行、加序号、合计行自动计算、工作表另存。

ykcbf1100

代码已经测试通过。

1. Sub ykcbf()  '//2024.2.4
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
5.     p = ThisWorkbook.Path & ""
   
6.     p1 = p & "下拨明细文件夹"
   
7.     If Not Fso.FolderExists(p1) Then Fso.CreateFolder p1
   
8.     fn = "下拨明细" & Format(Date, "yyyy-m-d")
   
9.     Sheets("下拨明细").Cells.Copy Sheets("配钞明细").[a1]
   
10.     With Sheets("配钞明细")
    
11.         arr = .UsedRange
    
12.         .DrawingObjects.Delete
    
13.         ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
14.         For i = 3 To UBound(arr)
    
15.             If arr(i, 1) <> Empty Then
    
16.                 If Val(arr(i, 12)) Then
    
17.                     m = m + 1
    
18.                     brr(m, 1) = m
    
19.                     For j = 2 To UBound(arr, 2)
    
20.                         brr(m, j) = arr(i, j)
    
21.                     Next
    
22.                 End If
    
23.             End If
    
24.         Next
    
25.         .[a3].Resize(m, 12) = brr
    
26.         r = m + 3
    
27.         .UsedRange.Offset(r).Clear
    
28.         .Cells(r, 1).Resize(1, 2) = "": .Cells(r, 3) = "合计"
    
29.         .Cells(r, 4).Resize(1, 9).FormulaR1C1 = "=SUM(R3C:R" & "[-1]C)"
    
30.         .[a3].Resize(m + 1, 12).Borders.LineStyle = 1
    
31.     End With
    
32.     Sheets("下拨明细").Copy
    
33.     Set wb = ActiveWorkbook
    
34.     wb.Sheets(1).DrawingObjects.Delete
    
35.     wb.SaveAs p1 & fn
    
36.     wb.Close 1
    
37.     Application.ScreenUpdating = True
    
38.     MsgBox "OK！"
    
39. End Sub
    

复制代码

施学明

谢谢，基本符合我的设想，真心感谢

施学明

不知咋送花？

cjc209

ykcbf1100 发表于 2024-2-4 14:00
代码已经测试通过。

掌握的vba知识真不少