[已解决][求助]怎样把代码改成组数形式

baiqghd

我用这个代码,如果有上千条数据,就非常的慢,想请高手帮我改成数组形式,让运行加快
Dim i As Long
    Dim n As Long
    n = 14
    Sheets("资料录入").Range("A14:Y65536").ClearContents
    For i = 2 To Sheets([h1].Value).Range("A65536").End(xlUp).Row
        If Sheets([h1].Value).Cells(i, 1) = Sheets("资料录入").Range("P3").Value Then

        Sheets("资料录入").Cells(n, 1) = Sheets([h1].Value).Cells(i, 2).Value
         Sheets("资料录入").Cells(n, 3) = Sheets([h1].Value).Cells(i, 4).Value
          Sheets("资料录入").Cells(n, 4) = Sheets([h1].Value).Cells(i, 5).Value
           Sheets("资料录入").Cells(n, 6) = Sheets([h1].Value).Cells(i, 7).Value
            Sheets("资料录入").Cells(n, 7) = Sheets([h1].Value).Cells(i, 8).Value
             Sheets("资料录入").Cells(n, 8) = Sheets([h1].Value).Cells(i, 9).Value
              Sheets("资料录入").Cells(n, 9) = Sheets([h1].Value).Cells(i, 10).Value
               Sheets("资料录入").Cells(n, 10) = Sheets([h1].Value).Cells(i, 11).Value
                Sheets("资料录入").Cells(n, 12) = Sheets([h1].Value).Cells(i, 13).Value
                 Sheets("资料录入").Cells(n, 13) = Sheets([h1].Value).Cells(i, 14).Value
                  Sheets("资料录入").Cells(n, 15) = Sheets([h1].Value).Cells(i, 16).Value
                   Sheets("资料录入").Cells(n, 17) = Sheets([h1].Value).Cells(i, 18).Value
                    Sheets("资料录入").Cells(n, 19) = Sheets([h1].Value).Cells(i, 20).Value
                  Sheets("资料录入").Cells(n, 25) = Sheets([h1].Value).Cells(i, 26).Value
            n = n + 1
        End If
    Next i

 

mFJu2W4V.rar (71.43 KB, 下载次数: 1)

2009-11-10 15:31 上传

点击文件名下载附件
[求助]怎样把代码改成组数形式

VBA密码123321
表格,请各位高手按一下查询按钮,然后看能不能怎样提速

[此贴子已经被作者于2009-11-10 15:31:00编辑过]

最佳答案

月排行榜 / 总排行榜

搁浅2008

2009-11-10 16:36

jekIODA6.rar (81.48 KB, 下载次数: 2)

2009-11-10 16:36 上传

点击文件名下载附件
[求助]怎样把代码改成组数形式
只改了下查询 因为你的上边很琐碎 没弄

跳转到最佳答案楼层

吕?布

Sub tt()
    Dim i As Long
    Dim n As Long
    Dim arrColumns, arrTmp
    Dim lLastRow As Long
    Dim sht资料录入 As Worksheet, shtH1 As Worksheet
    n = 14

    Set sht资料录入 = Sheets("资料录入")
    Set shtH1 = Sheets([h1].Value)
   
    arrColumns = Array(1, 3, 4, 6, 7, 8, 9, 10, 12, 13, 15, 17, 19, 25)
    lLastRow = shtH1.Range("A65536").End(xlUp).Row
    With sht资料录入
        .Range("A14:Y65536").ClearContents
        For i = LBound(arrColumns) To UBound(arrColumns)
            arrTmp = shtH1.Range(shtH1.Cells(2, i), shtH1.Cells(lLastRow, i))
            .Range(.Cells(n, i + 1), .Cells(lLastRow - 2 + n, i + 1)) = arrTmp
        Next i
    End With
End Sub

风彩依然

学习路过

搁浅2008

最好有附件

baiqghd

QUOTE:

以下是引用吕?布在2009-11-10 13:29:00的发言：

Sub tt()
    Dim i As Long
    Dim n As Long
    Dim arrColumns, arrTmp
    Dim lLastRow As Long
    Dim sht资料录入 As Worksheet, shtH1 As Worksheet
    n = 14

    Set sht资料录入 = Sheets("资料录入")
    Set shtH1 = Sheets([h1].Value)
   
    arrColumns = Array(1, 3, 4, 6, 7, 8, 9, 10, 12, 13, 15, 17, 19, 25)
    lLastRow = shtH1.Range("A65536").End(xlUp).Row
    With sht资料录入
        .Range("A14:Y65536").ClearContents
        For i = LBound(arrColumns) To UBound(arrColumns)
            arrTmp = shtH1.Range(shtH1.Cells(2, i), shtH1.Cells(lLastRow, i))
            .Range(.Cells(n, i + 1), .Cells(lLastRow - 2 + n, i + 1)) = arrTmp
        Next i
    End With
End Sub

你好,这个代码出现错误,我上传个附件帮我看一下吧

搁浅2008

密码[em42]

baiqghd

密码在一楼呢123321

搁浅2008

jekIODA6.rar (81.48 KB, 下载次数: 2)

2009-11-10 16:36 上传

点击文件名下载附件
[求助]怎样把代码改成组数形式
只改了下查询 因为你的上边很琐碎 没弄

吕?布

修正一下，循环中的i要改为arrColumns(i)

Dim i As Long
    Dim n As Long
    Dim arrColumns, arrTmp
    Dim lLastRow As Long
    Dim sht资料录入 As Worksheet, shtH1 As Worksheet
    n = 14

    Set sht资料录入 = Sheets("资料录入")
    Set shtH1 = Sheets(Sheets("资料录入").Range("h1").Value)
   
    arrColumns = Array(1, 3, 4, 6, 7, 8, 9, 10, 12, 13, 15, 17, 19, 25)
    lLastRow = shtH1.Range("A65536").End(xlUp).Row
    With sht资料录入
        .Range("A14:Y65536").ClearContents
        For i = LBound(arrColumns) To UBound(arrColumns)
            arrTmp = shtH1.Range(shtH1.Cells(2, arrColumns(i)), shtH1.Cells(lLastRow, arrColumns(i)))
            .Range(.Cells(n, arrColumns(i) + 1), .Cells(lLastRow - 2 + n, arrColumns(i) + 1)) = arrTmp
        Next i
    End With

baiqghd

QUOTE:

以下是引用搁浅2008在2009-11-10 16:36:00的发言：

只改了下查询 因为你的上边很琐碎 没弄

真是太谢谢你了,你这个真是超快呀,还有保存的代码可不可以帮我修改一下呀,保存的时候我是用复制粘贴的,数据一多也就慢了,所以希望能帮我改一下,真心的感谢呀