Улучшение производительности из программы VBA - PullRequest
0 голосов
/ 29 марта 2019

Я написал свою первую программу VBA, чтобы помочь мне идентифицировать оборудование с определенной конфигурацией. (С большой помощью из других сообщений на StackOverflow:)

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

Интересно, сможете ли вы помочь мне улучшить производительность этого Кодекса, поскольку он мой первый, наверное, я не использовал все инструменты, которые мог.

На протяжении всего процесса разработки, прежде чем дойти до этого финального кода, я экспериментировал с другими функциями, чтобы найти нужные мне строки в ячейках, такие как «Найти». Использование этой функции привело к более быстрой обработке, но информация была скопирована на новый лист в грязной форме. Я не мог понять, почему, поэтому я изменил тактику.

Хотя эта версия, которую я публикую здесь, работает, ее выполнение занимает много времени.


'Code Title: Search Hardware with required DuagonFW and IBC Platform Softwares

'#########'
'Objective'
'#########'

'This Macro provides a list of hardwares with the configuration, input by the user

Option Explicit

Sub SearchConfiguration()


'###############'
'User input part'
'###############'

'Variable declaration for the input from user

Dim Hardware As Workbook
Dim DSheet As Worksheet
Dim InfoSheet As Worksheet

'Set of Workbook and Sheets

Set Hardware = ThisWorkbook
Set DSheet = Hardware.Worksheets("Data")
Set InfoSheet = Hardware.Worksheets("Info")

'Variable declaration for the DuagonFW and IBC Platform

Dim DuagonFW As Variant
Dim ibc_platform As Variant

'Setting Information Table Head

InfoSheet.Activate
InfoSheet.Cells.Clear
InfoSheet.Range("A1").Value = "S/N"
InfoSheet.Range("B1").Value = "Duagon FW"
InfoSheet.Range("C1").Value = "IBC PLatform"
InfoSheet.Range("D1").Value = "Searched Duagon FW"
InfoSheet.Range("E1").Value = "Searched IBC PLatform"


'Getting configuration from user

GettingConfig:

    Dim ANS As Integer

    DuagonFW = InputBox("Insert the Duagon Firmware Number in the format d-xxxxxx-xxxxxx", vbDefaultButton1)

        If DuagonFW = vbNullString Then
            ANS = MsgBox("User canceled!", vbCritical)
            Exit Sub
        End If

    ibc_platform = InputBox("Insert the Duagon Firmware Number in the format Vxx.xx.xxxx", vbDefaultButton1)

        If ibc_platform = vbNullString Then
            ANS = MsgBox("User canceled!", vbCritical)
            Exit Sub
        End If

    Dim ConfigSpecifications As Variant

    ConfigSpecifications = MsgBox("The required configuration entered was: " & vbNewLine & "Duagon Firmware: " & DuagonFW _
    & vbNewLine & "IBC PLatform: " & ibc_platform & vbNewLine & "*Press No to retry", vbYesNoCancel, "CID06A Configuration")

    'Select Case ConfigSpecifications
        If ConfigSpecifications = vbNullString Or ConfigSpecifications = 2 Then
            ANS = MsgBox("User canceled!", vbCritical)
            Exit Sub
        End If
        If ConfigSpecifications = 1 Then
            InfoSheet.Range("D2").Value = DuagonFW
            InfoSheet.Range("E2").Value = ibc_platform
        End If
        If ConfigSpecifications = 7 Then
            GoTo GettingConfig
        End If

'##############################################################'
'Searching on the data the Hardwares with the required configuration'
'##############################################################'

'Activating Data Worksheet
DSheet.Activate

'Declaration of counters for the loop
Dim x As Integer
Dim y As Integer

'Setting counter
y = 1

'Loop through cells to compare strings with the input string and copy to the Information Table
    For x = 1 To 235
        If InStr(1, Cells(x, 7).Value, DuagonFW) > 0 And InStr(1, Cells(x, 8).Value, ibc_platform) > 0 Then
            y = y + 1
            Cells(x, 2).Copy InfoSheet.Range("A" & y)
            Cells(x, 7).Copy InfoSheet.Range("B" & y)
            Cells(x, 8).Copy InfoSheet.Range("C" & y)
        End If
    Next x

'Activation from information table
InfoSheet.Activate

'################'
'Formatting table'
'################'


Dim LstObj As ListObject
Dim rngDB As Range, n As Integer

        With InfoSheet
            Set rngDB = .Range("a1").CurrentRegion
            For Each LstObj In InfoSheet.ListObjects
                LstObj.Unlist
            Next
            If WorksheetFunction.CountA(rngDB) > 0 Then
                n = n + 1
                Set LstObj = .ListObjects.Add(xlSrcRange, rngDB, , xlYes)
                With LstObj

                    .Name = "Table" & n
                    .TableStyle = "TableStyleLight9"
                End With
            End If
        End With

End Sub

1 Ответ

0 голосов
/ 30 марта 2019

Изменение значения на значение2 является хорошей практикой.
Изменение большого количества имен объектов для WITH также является хорошей практикой.
Прекратите использовать Activate, используйте значения, вам не нужно активировать anithing в Excel, просто используйте свойства.
A немного улучшен, надеюсь, вы понимаете.

 Sub SearchConfiguration()


    '###############'
    'User input part'
    '###############'

    'Variable declaration for the input from user

    Dim Hardware As Workbook
    Dim DSheet As Worksheet
    Dim InfoSheet As Worksheet

    'Set of Workbook and Sheets

    Set Hardware = ThisWorkbook
    Set DSheet = Hardware.Worksheets("Data")
    Set InfoSheet = Hardware.Worksheets("Info")

    'Variable declaration for the DuagonFW and IBC Platform

    Dim DuagonFW As Variant
    Dim ibc_platform As Variant

    'Setting Information Table Head
    With InfoSheet
        .Activate
        .Cells.Clear
        .Range("A1").Value2 = "S/N"
        .Range("B1").Value2 = "Duagon FW"
        .Range("C1").Value2 = "IBC PLatform"
        .Range("D1").Value2 = "Searched Duagon FW"
        .Range("E1").Value2 = "Searched IBC PLatform"
    End With


    'Getting configuration from user

GettingConfig:

        Dim ANS As Integer

        DuagonFW = InputBox("Insert the Duagon Firmware Number in the format d-xxxxxx-xxxxxx", vbDefaultButton1)

            If DuagonFW = vbNullString Then
                ANS = MsgBox("User canceled!", vbCritical)
                Exit Sub
            End If

        ibc_platform = InputBox("Insert the Duagon Firmware Number in the format Vxx.xx.xxxx", vbDefaultButton1)

            If ibc_platform = vbNullString Then
                ANS = MsgBox("User canceled!", vbCritical)
                Exit Sub
            End If

        Dim ConfigSpecifications As Variant

        ConfigSpecifications = MsgBox("The required configuration entered was: " & vbNewLine & "Duagon Firmware: " & DuagonFW _
        & vbNewLine & "IBC PLatform: " & ibc_platform & vbNewLine & "*Press No to retry", vbYesNoCancel, "CID06A Configuration")

        'Select Case ConfigSpecifications
            If ConfigSpecifications = vbNullString Or ConfigSpecifications = 2 Then
                ANS = MsgBox("User canceled!", vbCritical)
                Exit Sub
            ElseIf ConfigSpecifications = 1 Then
                InfoSheet.Range("D2").Value2 = DuagonFW
                InfoSheet.Range("E2").Value2 = ibc_platform
            ElseIf ConfigSpecifications = 7 Then
                GoTo GettingConfig
            End If

    '##############################################################'
    'Searching on the data the Hardwares with the required configuration'
    '##############################################################'

    'Activating Data Worksheet
    DSheet.Activate

    'Declaration of counters for the loop
    Dim x As Integer
    Dim y As Integer

    'Setting counter
    y = 1

    'Loop through cells to compare strings with the input string and copy to the Information Table
        For x = 1 To 235
            If InStr(1, Cells(x, 7).Value, DuagonFW) > 0 And InStr(1, Cells(x, 8).Value, ibc_platform) > 0 Then
                y = y + 1
                Cells(x, 2).Value2 = InfoSheet.Range("A" & y)
                Cells(x, 7).Value2 InfoSheet.Range("B" & y)
                Cells(x, 8).Value2 InfoSheet.Range("C" & y)
            End If
        Next x

    'Activation from information table
    InfoSheet.Activate

    '################'
    'Formatting table'
    '################'


    Dim LstObj As ListObject
    Dim rngDB As Range, n As Integer

            With InfoSheet
                Set rngDB = .Range("a1").CurrentRegion
                For Each LstObj In InfoSheet.ListObjects
                    LstObj.Unlist
                Next
                If WorksheetFunction.CountA(rngDB) > 0 Then
                    n = n + 1
                    Set LstObj = .ListObjects.Add(xlSrcRange, rngDB, , xlYes)
                    With LstObj

                        .Name = "Table" & n
                        .TableStyle = "TableStyleLight9"
                    End With
                End If
            End With

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