请大神将下面代码优化，试运行能够快点

zrq648022547

本人从事的行业比较专业
需要提取大量出数据
可能数据太多，提取比较慢
数组又不会，所以请求给位大神给优化一下
能使数据提取高效点
---------------------------
代码用途说明：
给定查询条件，以及时间段，提取相关数据
时间是十几年的月数据
每一年的数据放在同一个工作簿的不同sheet表里面
根据查询条件提取对应数据
---------------------------
Private Sub CommandButton1_Click()
Dim box$, u%, year$, n%, m%, j%, i%, rng$, day%, a%, b%, x%, y%, w%, p%, an$, T%, rt%, rt1, rt2
Dim dd As Date
Dim r As Long

With Sheets("total")
If TextBox4 = "" Or TextBox5 = "" Then
T = Application.CountA(.[F:F]) + 1
box = TextBox1
For p = 2 To T
    If .Range("F" & p) = box Then
    x = p
    y = p
    GoTo line
    Exit Sub
    End If
Next
End If
x = CInt(TextBox4) + 1
y = CInt(TextBox5) + 1
line:
For w = x To y
TextBox1 = .Range("F" & w)
box = TextBox1
a = CInt(TextBox2)
b = CInt(TextBox3)
For day = a To b
Application.ScreenUpdating = False
year = day
Sheets(year).Activate
Sheets(year).[a1].Select
    n = Application.CountA(Sheets(year).[A:A])
    For i = 3 To n
            rng = Sheets(year).Range("A" & i)
            If rng = box Then
                        For j = 2 To 37
                        r = Application.CountA(.[A:A])
                            If Sheets(year).Cells(2, j) Like "*液量*" Then
                                .Range("A" & (r + 1)) = box
                                dd = Sheets(year).Cells(1, j)
                                .Range("B" & (r + 1)) = dd
                                .Range("A" & (r + 1)).Font.Color = vbRed
                                .Range("E" & (r + 1)) = Sheets(year).Cells(i, j + 2)
                                .Range("C" & (r + 1)) = Sheets(year).Cells(i, j)
                                .Range("D" & (r + 1)) = CInt(Sheets(year).Cells(i, j + 1))
                                If .Range("C" & (r + 1)) = 0 Then
                                .Range("D" & (r + 1)) = ""
                                .Range("C" & (r + 1)) = ""
                                .Range("E" & (r + 1)) = ""
                                End If
                            End If
                        Next
            End If
    Next
Application.ScreenUpdating = False
Next
Next
.Range("C2:C" & r + 1).NumberFormatLocal = "0.0"
.Range("D2:D" & r + 1).NumberFormatLocal = "0"
.Range("E2:E" & r + 1).NumberFormatLocal = "0.0"
.Activate
.[a1].Select
End With
End Sub
-------------------------------------------------------------------

longming3

亲，求助需要上传附件。
你的代码中，循环对单元格操作，运行就会很慢。数组可以加快计算过程的速度，然后在最后统一一次性设置单元格格式。

zrq648022547

longming3 发表于 2018-9-15 15:12
亲，求助需要上传附件。
你的代码中，循环对单元格操作，运行就会很慢。数组可以加快计算过程的速度，然后 ...

你好，因为数据不易上传，麻烦把你的qq私信给我
我给你把数据发过去
帮忙优化哈
十分感谢哈