Обновление структуры - PullRequest
       1

Обновление структуры

0 голосов
/ 30 октября 2018

Я хочу оптимизировать код, который я написал ниже. Потому что это занимает много времени для обработки .. Я прошу кого-то, чтобы помочь мне.

Это код для автоматической фильтрации данных 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 номеров Combobox и несколько текстовых полей. Этот код предназначен для сброса значений пользовательского интерфейса, который я подготовил в самом Excel.

Спасибо заранее.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...