增加判断语句

寒羽良

各位老师好。工作表一的数据，是每天都要做很多的，需要排版打印出来。很麻烦浪费时间 。
我做了一个简单的宏，自动生成表格。但表一A列的数值，正常是三个。但有时会有两个。需要 在只有两个下面加入一行空白行。最终效果如工作表二。
麻烦老师帮忙看一下。另外代码如果老师可以帮忙优化一下，就最好了。

smhf_6

表1现有数据16行，最多也就18行。
你说表1有很多，二个含义：一是可能出现100行、500行、1000行.....，二是每次最多18行，有N次？

你的宏功能，主要是格式、函数的设置。如果版面数量可控的话，且不采用复制-粘贴方式，这些可以是预制的，第一次设置后，今后是不会变的，故不需要每次运行。你只要用一个数组，将表1的数据幅值到表2的A:D列即可。

Sub dfdld()
Dim i, ir, arr, brr, p, q
Dim dc As Object
Set dc = CreateObject("scripting.dictionary")

'只有2行数据的判断及插入行
ir = Range("a60000").End(xlUp).Row
arr = Range("a1:e" & ir)
For i = 1 To ir
dc(arr(i, 1)) = dc(arr(i, 1)) + 1
Next
p = dc.keys
q = dc.items
For i = 0 To UBound(p)
If q(i) = 2 Then
ir = ir + 1
Cells(ir, 1) = p(i)
End If
Next
Range("a1").CurrentRegion.Sort Range("a1")

'取出值并赋值到表2
arr = Range("a1:b" & ir)
brr = Range("d1:e" & ir)

Sheet2.Range("a3").Resize(ir, 2) = arr
Sheet2.Range("c3").Resize(ir, 2) = brr

Set dc = Nothing
End Sub

寒羽良

smhf_6 发表于 2018-7-6 06:01
表1现有数据16行，最多也就18行。
你说表1有很多，二个含义：一是可能出现100行、500行、1000行.....，二 ...

老师您好.感谢您的帮助,非常好用。

smhf_6

补充一件事： 处理后的结果不一定要放在表2，可以另外设置一个工作簿，这个工作簿不带宏，是结果，发给各部门的。
当然，第一次是需要手工复制表2。粘贴到该工作簿，保证格式、函数不变。
然后，用宏，打开该工作簿赋值即可。