结构更新

Question

我想优化我在下面编写的代码。因为处理时间很长。 我要求某人帮助我。

这是用于自动过滤excel数据的代码

Sub Button14_Click()
Dim kj, ij As Integer
Dim ErrorNo(), ErrorMsg() As Variant

'Speed up Procedure
With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Cursor = xlWait
        .EnableCancelKey = xlErrorHandler
End With

Worksheets("Sheet1").TextBox1 = Null
'Sheet1.ComboBox1.Value = ""
'Sheet1.ComboBox2.Value = ""
'Sheet1.ComboBox3.Value = ""
'Sheet1.ComboBox4.Value = ""
'Sheet1.ComboBox5.Value = ""
Worksheets("Sheet1").TextBox3 = Null
Worksheets("Sheet1").TextBox4 = Null
Worksheets("Sheet1").TextBox5 = Null
Worksheets("Sheet1").TextBox6 = Null
Worksheets("Sheet1").TextBox7 = Null
Worksheets("Sheet1").Cells(11, 2).Value = Null
Worksheets(1).Range("A15").Show

Sheet1.Range("A15:O" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row).ClearContents

'Error arrays with values
ErrorMsg = Array("TextBox 34", "TextBox 39", "TextBox 40", _
"TextBox 41", "TextBox 42", "TextBox 43", "TextBox 44", _
"TextBox 45", "TextBox 46", "TextBox 47", "TextBox 48")
For ij = 0 To 10
        Worksheets(1).Shapes(ErrorMsg(ij)).TextFrame2.TextRange.Characters.Font.Fill.Transparency = 1
Next ij
Worksheets("Sheet1").Cells(12, 2).Value = 0 & " Result(s) found"


'---Combobox Declaration-------------------------------------------------------

Dim Lrow As Long, test As New Collection
Dim Value As Variant, Temp() As Variant
ReDim Temp(0)

On Error Resume Next
With Worksheets("DWG LOG")
    Lrow = .Range("E" & Rows.Count).End(xlUp).Row
Temp = .Range("E3:E" & Lrow).Value
End With

'---Combobox1/Base Model-----------------------------------------------------------
For Each Value In Temp
    If Len(Value) > 0 Then test.Add UCase(Value), CStr(Value)
Next Value

ReDim Temp(0)

Call SortList(test)

Sheet1.ComboBox1.Clear
Sheet1.ComboBox1.AddItem "N/A"

For Each Value In test
     Sheet1.ComboBox1.AddItem Value
Next Value

Set test = Nothing

'---Combobox2/Type-----------------------------------------------------------------

Temp = Worksheets("DWG LOG").Range("G3:G" & Lrow).Value

For Each Value In Temp
    If Len(Value) > 0 Then test.Add UCase(Value), CStr(Value)
Next Value

 ReDim Temp(0)

Call SortList(test)

Sheet1.ComboBox2.Clear
Sheet1.ComboBox2.AddItem "N/A"

For Each Value In test
     Sheet1.ComboBox2.AddItem Value
Next Value

Set test = Nothing

'---Combobox3/Style of Doc-----------------------------------------------------------------

Temp = Worksheets("DWG LOG").Range("D3:D" & Lrow).Value

For Each Value In Temp
    If (Len(Value) > 0 And Value <> "OBSOLETE") Then test.Add UCase(Value), CStr(Value)
Next Value

ReDim Temp(0)

Call SortList(test)

Sheet1.ComboBox3.Clear
Sheet1.ComboBox3.AddItem "ALL"

For Each Value In test
     Sheet1.ComboBox3.AddItem Value
Next Value

Set test = Nothing

'---Combobox4/Customer-----------------------------------------------------------------

Temp = Worksheets("DWG LOG").Range("I3:I" & Lrow).Value

For Each Value In Temp
    If Len(Value) > 0 Then test.Add UCase(Value), CStr(Value)
Next Value

ReDim Temp(0)

Call SortList(test)

Sheet1.ComboBox4.Clear
Sheet1.ComboBox4.AddItem "N/A"

For Each Value In test
     Sheet1.ComboBox4.AddItem Value
Next Value

Set test = Nothing

'---Combobox5/CaseLength----------------------------------------------------------------

Temp = Worksheets("DWG LOG").Range("F3:F" & Lrow).Value

For Each Value In Temp
    If Len(Value) > 0 Then test.Add UCase(Value), CStr(Value)
Next Value

ReDim Temp(0)

Call SortList(test)

Sheet1.ComboBox5.Clear
Sheet1.ComboBox5.AddItem "N/A"

For Each Value In test
     Sheet1.ComboBox5.AddItem Value
Next Value

Set test = Nothing

'---End Combobox declaration----------------------------------------------------

With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Cursor = xlDefault
        .StatusBar = False
        .EnableCancelKey = xlInterrupt
End With

End Sub

我需要一些建议来提高此代码的处理速度。 一种新方法也很好。

我有5个组合框和一些文本字段。这段代码是要重置我在excel本身中准备的UI的值。

先谢谢了。