[已解决]怎样使生成工资条速度加快（修改代码）

jiangslly

Sub scgzt()
    Dim a As Integer, b As Integer, r As Integer, c As Integer, d As Integer
    d = Sheet12.[A65536].End(xlUp).Row
    r = Sheet12.range("A1:A" & d).Rows.Count - 2
    b = Sheet12.range("A:AE").Columns.Count
      Sheet7.Select
      Sheet7.UsedRange.ClearContents
      For i = 1 To 3 * r + 1 Step 3
          For j = 1 To 25 Step 1
          Cells(i, j).Value = Sheet13.Cells(1, j)
          Next
        Next
        For c = 1 To d Step 1
      For i = 2 To 3 * r + 2 Step 3
         For j = 1 To 25 Step 1
           
           If j <= 8 Then
            
           Cells(i, j) = Sheet12.Cells(c, j)
           ElseIf j <= 22 Then
           Cells(i, j) = Sheet12.Cells(c, j + 5)
           Else
           Cells(i, j) = Sheet12.Cells(c, j + 6)
           End If
       Next
       Next
       Next
End Sub
这是我写的自动生成工资条的代码，发现运行的时候感觉死机了，一下生成不好，请问哪位高手有没有更好的办法加快速度?谢谢

最佳答案

月排行榜 / 总排行榜

zjdh

2011-8-15 19:21

是这样吗？
自动生成工资条.rar (24.91 KB, 下载次数: 44)

2011-8-15 19:20 上传

点击文件名下载附件

跳转到最佳答案楼层

zjdh

是这样吗？
自动生成工资条.rar (24.91 KB, 下载次数: 44)

2011-8-15 19:20 上传

点击文件名下载附件

jiangslly

回复 zjdh 的帖子

谢谢，成功了，不过我的要求不是那样的，后来我自己发现了问题，正确的代码如下：
Sub scgzt()
    Dim a As Integer, b As Integer, r As Integer, c As Integer, d As Integer
     Application.ScreenUpdating = False
    d = Sheet12.[A65536].End(xlUp).Row
    r = Sheet12.range("A1:A" & d).Rows.Count - 2
    b = Sheet12.range("A:AE").Columns.Count
      Sheet7.Select
      Sheet7.UsedRange.ClearContents
      For i = 1 To 3 * r - 2 Step 3
          For j = 1 To 24 Step 1
          Cells(i, j).Value = Sheet13.Cells(1, j)
          Next
        Next
     For c = 1 To r Step 1
           
             For j = 1 To 24 Step 1
            
           If j <= 8 Then
            
           Cells(3 * c - 1, j) = Sheet12.Cells(c + 2, j)
           ElseIf j <= 22 Then
           Cells(3 * c - 1, j) = Sheet12.Cells(c + 2, j + 5)
           Else
           Cells(3 * c - 1, j) = Sheet12.Cells(c + 2, j + 6)
           End If
       Next
       Next
Application.ScreenUpdating = True
   
End Sub
这样就可以达到我的效果了，不过还是谢谢你，毕竟也是生成工资条了

zjdh

你的不正确！
“工号”与“部门”的内容反啦！
你要第一行也利用起来容易：
Sub test()
    t = Timer
    arr = Sheet12.Range("A3:AE" & Sheet12.Range("A65536").End(3).Row)
    ReDim BRR(1 To UBound(arr) * 3, 1 To 25)
    For i = 1 To UBound(arr)
        For j = 1 To 25
            If j = 1 Then
                BRR(i * 3 - 2, 1) = arr(i, 1)
                BRR(i * 3 - 2, 2) = arr(i, 4)
                BRR(i * 3 - 2, 3) = arr(i, 2)
                BRR(i * 3 - 2, 4) = arr(i, 3)
                j = j + 3
            End If
            If j > 4 And j < 9 Then BRR(i * 3 - 2, j) = arr(i, j)
            If j > 8 And j < 18 Then BRR(i * 3 - 2, j) = arr(i, j + 5)
            If j > 17 Then BRR(i * 3 - 2, j) = arr(i, j + 6)
        Next
    Next
    With Sheet7
        .Range("A2").Resize(.Range("A65536").End(3).Row, 25).ClearContents
        .Range("A2").Resize(UBound(BRR), 25) = BRR
        W = .Range("A65536").End(3).Row
        arr = .Range("A1:Y1")
        For i = W To 3 Step -3
            .Cells(i - 1, 1).Resize(, 24) = arr
        Next
        .Range("J:J,K:K,W:W").WrapText = True
        .Activate
    End With
    MsgBox "创建成功!!总计用时 " & Format(Timer - t, "0.00") & " 秒!!", 64, "提示"
End Sub