好几天才可以复制粘贴完,那就来用一键生成询证函(增强版)

2019年11月19日06时40分内容来源:Excel不加班

与 30万 读者一起学Excel



截止下午5点,留言区排名前5名的赠送书籍Excel VBA跟卢子一起学 早做完,不加班 (基础入门版)


关于询证函早期发过文章,只要一键就可以生成全部,省心省力,不过这个模板还不够完美。每个公司的记录可能不止一条记录,而这个模板只针对一条记录。


好,现在从头开始说明。


VIP学员的问题,要给几百家公司制作往来款项询证函,手工搞了半天才制作了几十家。全部搞完,都不知道要花费几天的时间。


目录,需要将每个公司的信息分别填写到每个细分的表格。


询证函,按照这个模板,在黄色填充色单元格引用目录相应的内容。


细分的表格,生成效果。


注:填充颜色只是为了方便说明,实际操作中,可以去掉。


需要生成的公司实在太多了,如果借助传统的复制粘贴方法,需要好几天才可以完成。你的手估计要废了。


卢子想了想,还是用VBA搞定,先来体验一键生成的爽!真的只是一瞬间,快到你不敢想象。


在使用模板的时候,有一个注意点,现在说明一下。


目录和询证函这两个工作表名称不允许改动,里面表格的内容可以根据实际需求改动。


模板下载:

https://pan.baidu.com/s/1kzumt7vncNTTCiFi4d6XLA


Sub 询证函Tos()

Dim Dic As Object, Dk, Di

Dim Mlmr As Long, Sh As Worksheet

Dim Ml_Sh As Worksheet, Xzh_Sh As Worksheet

Dim ML01 As Long, ML02 As Integer, Arr, RowCous As Integer

Set Dic = CreateObject("Scripting.Dictionary")

Set Ml_Sh = Worksheets("目录")

Set Xzh_Sh = Worksheets("询证函")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

For Each Sh In Worksheets

If Sh.Name <> "目录" And Sh.Name <> "询证函" Then Sh.Delete

Next Sh

Application.DisplayAlerts = True

With Ml_Sh

Mlmr = .Cells(Rows.Count, 1).End(xlUp).Row

For ML01 = 6 To Mlmr

Dic(.Cells(ML01, 1).Value) = Dic(.Cells(ML01, 1).Value) & ML01 & "|"

Next ML01

Dk = Dic.keys

Di = Dic.items

End With

For ML01 = 0 To Dic.Count - 1

Xzh_Sh.Copy After:=Sheets(Sheets.Count)

With ActiveSheet

Arr = StrReverse(Mid(StrReverse(Di(ML01)), 2))

Arr = Split(Di(ML01), "|")

.Name = Ml_Sh.Cells(Arr(0), 2)

[d3] = Dk(ML01)

[a4] = "公司(个人)名称:" & Ml_Sh.Cells(Arr(0), 2)

Select Case UBound(Arr) - 1 <= 4

Case True

RowCous = 0

Case Else

RowCous = (UBound(Arr)) - 4

.Rows(11).EntireRow.Copy

.Rows(11).Offset(1).Resize(RowCous).Insert Shift:=xlDown

End Select

For ML02 = 0 To UBound(Arr) - 1

[a11].Offset(ML02, 0) = Ml_Sh.[d2].Text

[a11].Offset(ML02, 1) = Format(Ml_Sh.Cells(Arr(ML02), 5), "#,##0.00")

[a11].Offset(ML02, 2) = Format(Ml_Sh.Cells(Arr(ML02), 6), "#,##0.00")

[a11].Offset(ML02, 3) = Ml_Sh.Cells(Arr(ML02), 7)

Next ML02

[d18].Offset(RowCous) = Ml_Sh.[b2]

[d20].Offset(RowCous) = Ml_Sh.[f2].Text

End With

Next ML01

Application.ScreenUpdating = True

End Sub


推荐:不想加班,就来学一键生成往来款项询证函!

上篇:条件格式实现数据展示更直观(2019年各产品增长率分析图)

使用模板一时爽,一直使用一直爽,在卢子分享的那么多模板中,你最喜欢哪个?



作者:卢子,清华畅销书作者,《Excel效率手册 早做完,不加班》系列丛书创始人,个人公众号:Excel不加班(ID:Excelbujiaban)

请把「Excel不加班」推荐给你的朋友

最值得关注的微信公众号