BBS - Powered by Discuz! Board

标题: 给大家演示下最近做的（演示） [打印本页]

作者: zhendeaini 时间: 2016-8-31 11:12 标题: 给大家演示下最近做的（演示）

声明：不公开共享，如有兴趣可以私聊。一切尽在演示中，感谢大家多年的支持。
演示说明：
演示数据即为从系统导出的数据，格式与排版均为系统默认的，在此基础上，可能需要花少少时间整理（如果数据信息不完整的情况下），其他只要按演示那样即可一键批量生成。这样你就可以利用时间去忙其他的事情了。觉得是不是超级方便呢？

图片附件: 批量生成工作簿.gif (2016-8-31 11:12, 2.74 MB) / 该附件被下载次数 24
http://hahabbs.w1.luyouxia.net/bbs/attachment.php?aid=147911

作者: 匿名 时间: 2016-8-31 11:30

[12] [12] [12] ,好，多些业务交流是好同志！

作者: rx782 时间: 2016-8-31 11:37

我地就系人工做左2000多份表啊[49]

作者: zhendeaini 时间: 2016-8-31 11:41 标题: 回复 3楼帖子的帖子

其实不用那么累的。2000多份表其实也就是37分钟的事情。[32]

作者: 匿名 时间: 2016-8-31 11:44

VBA原来可以向固定格式导数据啊，长见识了

作者: 匿名 时间: 2016-8-31 11:44

引用:

原帖由 rx782 于 2016-8-31 11:37 发表
我地就系人工做左2000多份表啊[49]

[42] 呃，我这里是半自动人工

作者: 匿名 时间: 2016-8-31 11:45

引用:

原帖由 zhendeaini 于 2016-8-31 11:41 发表
其实不用那么累的。2000多份表其实也就是37分钟的事情。[32]

用VBA也要37分钟吗，VBA是不是也是用写入文件另存的方法？

作者: 匿名 时间: 2016-8-31 11:46

厉害！是我们高州的同志吗？

作者: zhendeaini 时间: 2016-8-31 11:48 标题: 回复 7楼帖子的帖子

之前测试过生成55个文档（包括匹配数据），大概1分多钟，按此计算，大概需要37分钟吧。

作者: zhendeaini 时间: 2016-8-31 11:48 标题: 回复 8楼帖子的帖子

不好意思，我不是高州局的哦。感谢关注。

作者: 匿名 时间: 2016-8-31 11:49

引用:

原帖由 zhendeaini 于 2016-8-31 11:48 发表
之前测试过生成55个文档（包括匹配数据），大概1分多钟，按此计算，大概需要37分钟吧。

[49] 比我快多了，不会VBA，靠小精灵15秒一个

作者: zhendeaini 时间: 2016-8-31 11:52 标题: 回复 11楼帖子的帖子

没有用过小精灵，可能效果差不多吧。

作者: zhendeaini 时间: 2016-8-31 11:53 标题: 回复 2楼帖子的帖子

谢谢，这个平台就是交流的平台。欢迎提出有建设性意见。[39]

作者: zhendeaini 时间: 2016-8-31 11:55 标题: 回复 6楼帖子的帖子

不知道你所说的半自动是怎么个概念。因为我这个也有个前提，那就是你得保证数据是准确的。然后按照要求将数据摆放相应的单元格即可。

作者: zhendeaini 时间: 2016-8-31 11:57 标题: 回复 5楼帖子的帖子

嗯，个人觉得Excel是强大的数据处理工具，个人掌握的只是皮毛而已。

作者: 二师兄 时间: 2016-8-31 14:18

嘿嘿。。。我的方法基本相同一秒左右一个表，2000户差不多也是三四十分钟吧

我们局这项任务目前就只需要我一个人[67]

作者: 二师兄 时间: 2016-8-31 14:21

顺便分享一下代码，欢迎拍砖：
Sub 按钮1_Click()
Dim i As Variant
Dim aa As Variant
Dim bb As Variant
Dim flag As Byte

i = 2
Do Until Range("F" & i).Value = ""
      i = i + 1
Loop
i = i - 1

Rows("2:" & i).Select
ActiveWorkbook.Worksheets("汇总表").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("汇总表").Sort.SortFields.Add Key:=Range("F2:F" & i) _
      , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("汇总表").Sort
      .SetRange Range("A2:w" & i)
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
End With

aa = "[汇总表.xlsm]汇总表!"
bb = "[调查表.xls]2016!"
flag = 0
j = 15
i = 2
Do Until Range(aa & "F" & i).Value = ""
      If flag = 0 Then
         Workbooks.Open Filename:=ThisWorkbook.Path & "\调查表.xls"
         Range(bb & "D6").Value = Range(aa & "E" & i).Value    '纳税人名称
         Range(bb & "H6").Value = Range(aa & "F" & i).Value    '纳税人识别号
         Range(bb & "D7").Value = Range(aa & "G" & i).Value    '联系人
         Range(bb & "H7").Value = Range(aa & "H" & i).Value    '联系人电话
         Range(bb & "D8").Value = Range(aa & "I" & i).Value    '主管税局
         Range(bb & "H8").Value = Range(aa & "X" & i).Value    '电子邮箱
         Range(bb & "D9:E9").Value = Range(aa & "J" & i).Text    '注册类型代码
         Range(bb & "D10:E10").Value = Range(aa & "L" & i).Text    '行业代码

         Range(bb & "D11").Value = Int(Range(aa & "N" & i).Value + 0.5)    '营业额
         Range(bb & "H11").Value = Int(Range(aa & "O" & i).Value + 0.5)    '利润
         Range(bb & "D12").Value = Int(Range(aa & "P" & i).Value + 0.5)    '应缴
         Range(bb & "H12").Value = Int(Range(aa & "Q" & i).Value + 0.5)    '实缴
         flag = 1
      End If
      '填减免数
      Range(bb & "B" & j).Value = Range(aa & "R" & i).Value
      Range(bb & "F" & j).Value = Range(aa & "T" & i).Value
      Range(bb & "G" & j).Value = Range(aa & "U" & i).Value
      Range(bb & "H" & j).Value = Range(aa & "V" & i).Value
      Range(bb & "I" & j).Value = Range(aa & "W" & i).Value
      j = j + 1

      If Range(aa & "F" & i).Value <> Range(aa & "F" & i + 1).Value Then
         Windows("调查表.xls").Activate
         ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range(aa & "D" & i).Value & "\" _
            & Range(aa & "F" & i).Value & ".xls"
         ActiveWindow.Close       '关闭
         flag = 0
         j = 15
      End If
      i = i + 1
Loop

End Sub

作者: zhendeaini 时间: 2016-8-31 14:27 标题: 回复 17楼帖子的帖子

嗯，代码不同，方法类似。[12]

欢迎光临 BBS (http://hahabbs.w1.luyouxia.net/bbs/)