代码优化请教

我是小黑屋

请教一下，优化一下代码的运行速度


工资表.zip (36.84 KB, 下载次数: 8)

2023-3-7 11:32 上传

点击文件名下载附件

shiruiqiang

1、发excel表，2、不要反复操作单元格

我是小黑屋

shiruiqiang 发表于 2023-3-7 11:23
1、发excel表，2、不要反复操作单元格

已上传excel表

gwjkkkkk

Option Explicit
Sub test()
    Dim ar, br, cr, i&, j&, Rng As Range, iPosRow&
   
    cr = Array(1, 2, 6, 3, 18, 21, 23, 19, 24, 26, 27, 28, 29, 30, 32, 34)
    ar = Range("C6", Cells(Rows.Count, "AJ").End(3))
    Set Rng = Sheets(2).[A1].CurrentRegion.Resize(4)
   
    With Sheets(3)
        .Cells.Clear
        For i = 1 To UBound(ar)
            iPosRow = (i - 1) * 5 + 1
            Rng.Copy .Cells(iPosRow, 1)
            With .Cells(iPosRow, 1).CurrentRegion.Resize(4)
                 br = .Value
                 For j = 0 To UBound(cr)
                     br(4, j + 1) = ar(i, cr(j))
                 Next j
                 br(4, 3) = br(4, 3) + ar(i, 7)
                  .Value = br
                 .EntireColumn.AutoFit
                 .EntireRow.AutoFit
            End With
        Next i
    End With
   
    Sheets(3).Activate
    Beep
End Sub

gwjkkkkk

请参考。。。

半百

试试看？？？

sxbjzjf110

参与一下。。。。

sxbjzjf110

参与一下。。。。

我是小黑屋

gwjkkkkk 发表于 2023-3-7 12:54
请参考。。。

你好，如果需要保留原有复制的格式怎样修改下？因为还需要打印出来，表中模板那里是刚好调好列宽和行高的

gwjkkkkk

我是小黑屋 发表于 2023-3-7 15:22
你好，如果需要保留原有复制的格式怎样修改下？因为还需要打印出来，表中模板那里是刚好调好列宽和行高的

请参考。。。