求大神优化一下，复制表格多时，速度慢

Kavis

RT

所有数据均在数据表里，原理是根据数据表的行数，复制样表，然后分别把数据表的各行数据填入工作表第一行，最后工作表根据该表第一行的数据填写单据。

感觉EXCEL每填一个新的数据就会把以前的所有数据全部重算一遍，关掉自动计算也不行，导致数据多于200行时，计算就开始变慢了，500多行的数据表，全部生成完，需要十几分钟。

求大神给优化一下宏或者流程，让它能跑快一点儿。

3190496160

带么本身并不慢，而是你的公式拖慢了代码运行的速度，另外：
每个人生成一个工作表，500多个人，就要生成500多个工作表？似乎打印就是一个大问题。
所有的工资条都生成到一个工作表中不是更方便打印吗？？？

3190496160

Sub 工资条()
Application.ScreenUpdating = False
Dim ar As Variant
Application.DisplayAlerts = False
For Each sh In Sheets
    If sh.Index > 2 Then
        sh.Delete
    End If
Next sh
Application.DisplayAlerts = True
With Sheets("汇总表")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    y = .Cells(1, Columns.Count).End(xlToLeft).Column
    If r < 3 Then MsgBox "汇总表为空！": End
    ar = .Range("a2:bj" & r)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 2)) <> "" Then
        Sheets("样表").Copy after:=Sheets(Sheets.Count)
        With ActiveSheet
            .[c3] = ar(i, 2)
            .Name = ar(i, 1) & "_" & ar(i, 2)
            lh = 1: xh = 4
            For j = 3 To UBound(ar, 2) Step 12
                xh = xh + 1
                lh = 1
                For s = j To j + 11
                    lh = lh + 1
                    .Cells(xh, lh) = ar(i, s)
                Next s
            Next j
        End With
    End If
Next i
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

这样不是更方便吗？？

半百

去掉样表里所有公式

Kavis

半百 发表于 2023-5-1 11:19
去掉样表里所有公式

感谢您的回复
    调试了一下，改了一些参数，运行速度确实快

Sub 工资条Eh1()
Dim t
t = Timer '计时
Set sh = Sheets("样表")
arr = Sheets("汇总表").UsedRange '创建数组为数据表活动区域
For i = 3 To UBound(arr)         'arr数组行数
r = 3
n = 1
sh.Copy after:=Sheets(Sheets.Count) '复制工作表
With ActiveSheet
.Name = arr(i, 1)                  '改名
brr = .[a4:m11]
brr(1, 3) = arr(i, 2)              '填姓名
For j = 3 To UBound(arr, 2)        'ub*为arr数组列数
  n = n + 1
  If n > 13 Then                    'n为列标,r为行标
  n = 2
  r = r + 1
  End If
  brr(r, n) = arr(i, j)
  Next
  .[a4:m11] = brr
End With
Next
MsgBox Timer - t
End Sub


还有一点儿小问题需要请教一下，如果工作表里数据不是规整的5行12列，且不同类的工作表，填写的东西都不一样，有什么好的办法实现么？

另外，这些工作簿并不是一次性，数据经常需要加行数，咱这个宏，第二次运行，就开始运行报错1004了。。。

本人纯小白，代码全靠360翻译，还望大神不吝赐教。。。

Kavis

3190496160 发表于 2023-5-1 11:08
这样不是更方便吗？？

感谢您的回复

      是这样，我这个表只是做个例子，我的日常工作要做大量的重复表格，平均每天600份，表格有几十种，并不是每种表格都是规规矩矩的填5行12列数据，需要填的页数，列数，行数，要填 的位置均不一样，计算的内容也不一样，几乎没法去掉公式，最少也得是c3=a2这样的，所以我做模板的时候才在每个工作表的第一行弄了个辅助数据行，方便检查数据而不是直接VBA填数据到表里。

      不做在一个工作表里，是因为有些数据量大，有15000多行，全做一个工作表里面，改表格样式、追加行什么的会是个灾难，领导嘛，你懂的，啥都做的好好的，也得让你改改行高列宽字体。。。。一人一张表，可以选所有工作表一起改，包括设置打印区域或者分页符啥的，只用在样表里改好，复制的新表就会直接带过去。

      还有一个需求是，某一类表格，我原来已经做好了200份，现在我又要做100份，只用在数据表里加100行，然后运行宏就可以直接追加表格。目测咱这个宏，是先删除掉旧表，再全部重做，页数超过1000页，光删除都要好久的样子。。。。

Kavis

半百 发表于 2023-5-1 11:19
去掉样表里所有公式

我调试了一下，运行速度确实快了很多，目测是因为整数组填写数据的原因，改过的代码被吃掉了，感谢你提供的思路。

半百

Kavis 发表于 2023-5-1 12:53
感谢您的回复
    调试了一下，改了一些参数，运行速度确实快

补充问题
1：要看具体情况。
2：如果添加数据不是在中间插入的话，可以取得现有工作表数量或最后的工作表名，然后定位从多少行开始循环添加工作表。