Повышение производительности с помощью программы VBA

ProgramBox

Повышение производительности с помощью программы VBA

Post author:admin
Запись опубликована:30 апреля, 2023
Post category:Вопросы по программированию

#excel #vba

Вопрос:

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

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

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

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

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

 
'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: " amp; vbNewLine amp; "Duagon Firmware: " amp; DuagonFW _
    amp; vbNewLine amp; "IBC PLatform: " amp; ibc_platform amp; vbNewLine amp; "*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" amp; y)
            Cells(x, 7).Copy InfoSheet.Range("B" amp; y)
            Cells(x, 8).Copy InfoSheet.Range("C" amp; 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" amp; n
                    .TableStyle = "TableStyleLight9"
                End With
            End If
        End With

End Sub

1. Вместо использования Cells(x, 2).Copy InfoSheet.Range("A" amp; y) попробуйте Cells(x, 2) = InfoSheet.Range("A" amp; y) . Кроме того, поскольку этот код работает, я бы опубликовал его вместо Code Review.

2. Я считаю, что это лучше подходит для обзора кода нашего сайта siter.

3. Одним из способов было бы отфильтровать вашу таблицу в соответствии с вашими требованиями. Запишите отображаемый диапазон в массив и затем вставьте его

4. Я согласен с рекомендацией для проверки кода . Тангенциальный: вам не нужно писать все эти существительные с заглавной буквы. Например, предложение, заканчивающееся на «этот код», выглядит неуклюжим. Просто используйте «этот код».

5. Извините, мой компьютер автоматически использует эту заглавную букву… Немцы, хе-хе! Это и мой первый пост тоже. Поставлю на проверку кода, спасибо

Ответ №1:

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

  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: " amp; vbNewLine amp; "Duagon Firmware: " amp; DuagonFW _
        amp; vbNewLine amp; "IBC PLatform: " amp; ibc_platform amp; vbNewLine amp; "*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" amp; y)
                Cells(x, 7).Value2 InfoSheet.Range("B" amp; y)
                Cells(x, 8).Value2 InfoSheet.Range("C" amp; 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" amp; n
                        .TableStyle = "TableStyleLight9"
                    End With
                End If
            End With

    End Sub