请高手帮看看为什么我的代码跑的慢

popekai

初学者，麻烦帮忙看下哪些地方可以改进，为什么跑起来很慢，也就1万多行数据，谢谢，代码如下：

Option Explicit

Sub Generate()

With Worksheets("Sheet2").Range("A9:K9999")
.ClearContents                                             '清除单元格数据
.Interior.Color = xlNone                                   '清除单元格填充颜色
.Font.Color = RGB(0, 0, 0)                                 '单元格字体恢复黑色
End With

Dim i As Integer
Dim x As Integer
x = 9
For i = 3 To Sheet1.Range("G65536").End(xlUp).Row          'Excel一共有65536行，计算最后一行数据所在行数
    With Worksheets("sheet2")
        If .Range("B5").Value = Sheet1.Range("G" & i).Value Then
           .Range("A" & x).Value = Worksheets("sheet1").Range("G" & i).Value
           .Range("B" & x).Value = Worksheets("sheet1").Range("H" & i).Value
           .Range("C" & x).Value = Worksheets("sheet1").Range("E" & i).Value
           .Range("D" & x).Value = Worksheets("sheet1").Range("F" & i).Value
           .Range("E" & x).Value = Worksheets("sheet1").Range("P" & i).Value
           .Range("F" & x).Value = Worksheets("sheet1").Range("R" & i).Value
           .Range("G" & x).Value = Worksheets("sheet1").Range("T" & i).Value
           .Range("H" & x).Value = Worksheets("sheet1").Range("S" & i).Value
           .Range("I" & x).Value = Worksheets("sheet1").Range("X" & i).Value
           .Range("J" & x).Value = Worksheets("sheet1").Range("Z" & i).Value + Worksheets("sheet1").Range("AE" & i).Value
           x = x + 1
        End If
    End With
Next i
End Sub

weisilisid

1、同一个工作簿中，是不是有很多易失性函数，比如vlookup …等，如果是的话，跟vba代码无关，肯定会巨慢
2、可以把屏幕刷新关了application.ScreenUpdating =False  ，处理完之后，再重新打开 application.ScreenUpdating =True
3、可以换个思路，用copy.range 复制过去（或者数组填充），再把列的位置调整一下，这思路肯定比你用一个一个填写过去快

wj2368

weisilisid 发表于 2018-8-17 09:35
同一个工作簿中，是不是有很多易失性函数，比如vlookup …等，如果是的话，跟vba代码无关，肯定会巨慢

用数组。。。。。。。。。

weisilisid

wj2368 发表于 2018-8-17 09:40
用数组。。。。。。。。。

嗯，谢谢老师指导，
刚是没写完，就发出来了，后来补充了一些

zopey

数组 或sql ，上传excel附件，可以给你简单写一段 代码。

Chip_Kenny

沒測試

1. Sub Generate()
   
2. Dim i As Integer, j As Integer
   
3. Dim x As Integer
   
4. Dim z&, Sht1Arr, Sht2Brr, a
   
5. x = 9
   
6. With Sheet1
   
7.     z = .Range("G65536").End(xlUp).Row
   
8.     Sht1Arr = .Range("e1:z" & z).Value
   
9. End With
   
10. a = Array(3, 4, 1, 2, 12, 14, 16, 15, 20, 22)
    
11. Sht2Brr = Worksheets("Sheet2").Range("a1:j" & z).Value
    
12. With Worksheets("Sheet2").Range("A9:K9999")
    
13.     .ClearContents
    
14.     .Interior.Color = xlNone
    
15.     .Font.Color = RGB(0, 0, 0)
    
16.     For i = 3 To z
    
17.         If .Range("B5").Value = Sht1Arr(i, 3) Then
    
18.             For j = 0 To UBound(a)
    
19.                 Sht2Brr(x, j + 1) = Sht1Arr(i, a(j))
    
20.             Next
    
21.             Sht2Brr(x, j) = Sht2Brr(x, j) + Worksheets("sheet1").Range("AE" & i).Value
    
22.            x = x + 1
    
23.         End If
    
24.     Next i
    
25.     .Range("a1").Resize(i - 1, 10) = Sht2Brr
    
26. End With
    
27. End Sub

复制代码