『懒人』办公现状 - 一键搞定！！！
关于销售日前，昨天我们写了一批，通过技巧法完成批量生成，但是对于我这种“懒人”，还是有点麻烦的！今天我们就分享一种更加高效的方法! 一键搞定
日报 | 批量生成
功能实现
last_date = VBA.DateSerial(Year(Now), imonth + 1, 0)sht.Name Like "?*月?*日"'公众号：Excel办公实战
'作者：E精精
'日期：2021年6月16日
'------------------------------------------------------------------
Sub copyByMD()
Dim bMonth As Byte, last_day As Byte
Dim last_date As Date, current_date As Date
'提示输入月份
imonth = Val(InputBox("请输入月份：", "月份", 1))
'对应月份的最后一天
last_date = VBA.DateSerial(Year(Now), imonth + 1, 0)
last_day = Day(last_date)
Application.ScreenUpdating = False
For Each sht In ThisWorkbook.Sheets
If sht.Name Like "?*月?*日" Then
'关闭弹窗
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = True
End If
Next
For i = 1 To last_day
'复制模板
Sheets("模板").Copy after:=Sheets(Sheets.Count)
'根据i对应的日期
current_date = VBA.DateSerial(Year(Now), imonth, i)
'设置Sheet名称为月日格式
ActiveSheet.Name = Format(current_date, "m月d日")
'表头写入销售日期
ActiveSheet.[C2] = current_date
'删除按钮
For Each shp In ActiveSheet.Shapes
shp.Delete
Next
Next
Application.ScreenUpdating = True
MsgBox "日报已生成," & imonth & "月-共" & last_day & "张"
End Sub
日报 | 汇总表
汇总 | 函数方法
=TEXT(IF(MONTH(DATE(YEAR(TODAY()),$B$1,ROW(A1)))=$B$1,DATE(YEAR(TODAY()),$B$1,ROW(A1)),""),"m月d日")=IFERROR(SUM(INDIRECT(B4&"!E4:E999")),"")sheet名称!单元格地址VBA | 明细汇总
'公众号：Excel办公实战
'作者：E精精
'日期：2021年6月16日
'------------------------------------------------------------------
Sub combineData()
Dim sht As Worksheet
Dim totalMaxRow As Long '汇总表最大行
Dim maxRow As Long '每日分表最大行
Dim totalSht As Worksheet
Set totalSht = Sheets("明细汇总")
'清空历史数据并写入表头
With totalSht
.Cells.Clear '清空
.Range("a1").Resize(1, 6) = _
[{"日期","名称","单价","数量","金额","销售员"}]
End With
For Each sht In ThisWorkbook.Sheets
If sht.Name Like "?*月?*日" Then
'每日最大行
maxRow = sht.Cells(Rows.Count, 2).End(3).Row
If maxRow > 3 Then
'汇总表中最大行下空白行
totalMaxRow = totalSht.Cells(Rows.Count, 1).End(3).Row + 1
'写入日期
totalSht.Cells(totalMaxRow, 1). _
Resize(maxRow - 3, 1).Value = sht.Name
'写入数据
totalSht.Cells(totalMaxRow, 2).Resize(maxRow - 3, 5).Value = _
sht.Range("B4").Resize(maxRow - 3, 5).Value
End If
End If
Next
totalSht.Activate
MsgBox "全部汇总完成~"
End Sub
赞 (0)