Помогите оптимизировать код

[ Закрыто ] Помогите оптимизировать код

Пользователь

Сообщений: 77 Регистрация: 18.01.2020

23.01.2020 21:19:12

Добрый день!
Прошу подсказки и помощи в оптимизации кода. Есть книга с десятком листов, 9 сбор данных и 1 статотчет. Ввод данных в книгу реализован через форму с 9 MultiPage, там же предусмотрено редактирование/удаление введённых данных. Кнопка добавить запись работает следующем образом:

Скрытый текст

Код

Private Sub CommandButton1_Click() 'кнопка добавить
Dim cT As Control
Dim iLastRow As Long
    iLastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
'блок Лист_1
    Select Case MultiPage1.Value
        Case Is = 0
            On Error Resume Next
            Cells(iLastRow, 4) = 1
            Cells(iLastRow, 4) = Cells(iLastRow - 1, 4) + 1
            Cells(iLastRow, 1) = Me.TextBox1 & " " & Me.TextBox2 & " " & Me.TextBox3
            Cells(iLastRow, 2) = Me.TextBox4
            Cells(iLastRow, 3) = Me.TextBox5
            Cells(iLastRow, 5) = Me.ComboBox4
            Cells(iLastRow, 6) = Me.ComboBox2
            Cells(iLastRow, 7) = Me.ComboBox3
            Cells(iLastRow, 8) = Me.ComboBox7
            Cells(iLastRow, 9) = Me.ComboBox8
            Cells(iLastRow, 10) = Me.ComboBox1
            Cells(iLastRow, 11) = Me.TextBox6
            Cells(iLastRow, 12) = Me.ComboBox5
            Cells(iLastRow, 13) = Me.ComboBox6
    
            If CheckBox1.Value = True Then
                Cells(iLastRow, 17) = "принят"
                CheckBox1.Enabled = False
            End If
            Me.CheckBox1 = False
'конец блока Лист_1
'блок Лист_2
   
        Case Is = 1
            On Error Resume Next
            Cells(iLastRow, 4) = 1
            Cells(iLastRow, 4) = Cells(iLastRow - 1, 4) + 1
            Cells(iLastRow, 1) = Me.TextBox8 & " " & Me.TextBox9 & " " & Me.TextBox10
            Cells(iLastRow, 2) = Me.TextBox11
            Cells(iLastRow, 3) = Me.TextBox7
            Cells(iLastRow, 5) = Me.ComboBox11
            Cells(iLastRow, 6) = Me.TextBox12
            Cells(iLastRow, 7) = Me.TextBox13
            Cells(iLastRow, 8) = Me.ComboBox17
            Cells(iLastRow, 9) = Me.ComboBox12
            Cells(iLastRow, 10) = Me.ComboBox15
            Cells(iLastRow, 11) = Me.ComboBox16
            Cells(iLastRow, 12) = Me.ComboBox10
            Cells(iLastRow, 13) = Me.ComboBox13
            Cells(iLastRow, 14) = Me.ComboBox14
        
'конец бдока Лист_2
'блок Лист_3
        Case Is = 2
            On Error Resume Next
            Cells(iLastRow, 4) = 1
            Cells(iLastRow, 4) = Cells(iLastRow - 1, 4) + 1
            Cells(iLastRow, 1) = Me.TextBox23 & " " & Me.TextBox24 & " " & Me.TextBox25
            Cells(iLastRow, 2) = Me.TextBox26
            Cells(iLastRow, 3) = Me.TextBox30
            Cells(iLastRow, 5) = Me.ComboBox47
            Cells(iLastRow, 6) = Me.TextBox27
            Cells(iLastRow, 7) = Me.TextBox28
            Cells(iLastRow, 8) = Me.ComboBox38
            Cells(iLastRow, 9) = Me.ComboBox48
            Cells(iLastRow, 12) = Me.ComboBox46
            Cells(iLastRow, 13) = Me.ComboBox49
            Cells(iLastRow, 14) = Me.ComboBox50
'конец блока Лист_3
'блок Лист_4
        Case Is = 3
            On Error Resume Next
            Cells(iLastRow, 4) = 1
            Cells(iLastRow, 4) = Cells(iLastRow - 1, 4) + 1
            Cells(iLastRow, 1) = Me.TextBox31 & " " & Me.TextBox32 & " " & Me.TextBox33
            Cells(iLastRow, 2) = Me.TextBox34
            Cells(iLastRow, 3) = Me.TextBox38
            Cells(iLastRow, 5) = Me.ComboBox60
            Cells(iLastRow, 6) = Me.TextBox35
            Cells(iLastRow, 7) = Me.TextBox36
            Cells(iLastRow, 8) = Me.ComboBox51
            Cells(iLastRow, 9) = Me.ComboBox61
            Cells(iLastRow, 12) = Me.ComboBox59
            Cells(iLastRow, 13) = Me.ComboBox62
            Cells(iLastRow, 14) = Me.ComboBox63
'конец блока Лист_4
'блок Лист_5
        Case Is = 4
            On Error Resume Next
            Cells(iLastRow, 1) = 1
            Cells(iLastRow, 1) = Cells(iLastRow - 1, 1) + 1
            Cells(iLastRow, 2) = Me.TextBox39
            Cells(iLastRow, 3) = Me.ComboBox64
            Cells(iLastRow, 4) = Me.TextBox40
            Cells(iLastRow, 5) = Me.TextBox40 / TextBox41 * 100
            Cells(iLastRow, 6) = Me.ComboBox65
            Cells(iLastRow, 7) = Me.ComboBox66
            Cells(iLastRow, 8) = Me.ComboBox67
            Cells(iLastRow, 9) = Me.ComboBox68
            If CheckBox2.Value = True Then
                Cells(iLastRow, 12) = "+"
                CheckBox2.Enabled = False
            End If
            If CheckBox3.Value = True Then
                Cells(iLastRow, 13) = "+"
                CheckBox3.Enabled = False
            End If
            Cells(iLastRow, 14) = Me.TextBox42
    
'конец блока Лист_5
'блок Лист_6
        Case Is = 5
            Cells(iLastRow, 1) = Me.TextBox46
            Cells(iLastRow, 2) = Me.TextBox47
            Cells(iLastRow, 3) = Me.TextBox43
            Cells(iLastRow, 4) = Me.ComboBox72
            Cells(iLastRow, 5) = Me.TextBox48
            Cells(iLastRow, 6) = Me.ComboBox73
            Cells(iLastRow, 7) = Me.ComboBox69
            Cells(iLastRow, 8) = Me.ComboBox70
            Cells(iLastRow, 9) = Me.TextBox44
            Cells(iLastRow, 10) = Me.TextBox45
            Cells(iLastRow, 11) = Me.ComboBox71
            If CheckBox4.Value = True Then
                Cells(iLastRow, 12) = "заведен"
                CheckBox4.Enabled = False
            End If
    
'конец блока Лист_6
'блок Лист_7
        Case Is = 6
            On Error Resume Next
            Cells(iLastRow, 1) = 1
            Cells(iLastRow, 1) = Cells(iLastRow - 1, 1) + 1
            Cells(iLastRow, 2) = Me.TextBox49
            Cells(iLastRow, 3) = Me.ComboBox74
            Cells(iLastRow, 4) = Me.TextBox51 & " " & Me.ComboBox75
            Cells(iLastRow, 6) = Me.ComboBox76
            Cells(iLastRow, 7) = Me.TextBox54
            Cells(iLastRow, 8) = Me.TextBox53
            Cells(iLastRow, 9) = Me.ComboBox77
            If CheckBox5.Value = True Then
                Cells(iLastRow, 5) = "+"
                CheckBox5.Enabled = False
            End If
    
'конец блока Лист_7
'блок Лист_8
        Case Is = 7
            On Error Resume Next
            Cells(iLastRow, 1) = 1
            Cells(iLastRow, 1) = Cells(iLastRow - 1, 1) + 1
            Cells(iLastRow, 2) = Me.TextBox55 & " " & Me.TextBox56 & " " & Me.TextBox57
            Cells(iLastRow, 3) = Me.TextBox58
            Cells(iLastRow, 4) = DateDiff("yyyy", Me.TextBox58, Date)
            Cells(iLastRow, 5) = Me.ComboBox78
            Cells(iLastRow, 6) = Me.TextBox59
            Cells(iLastRow, 7) = Me.ComboBox87
            Cells(iLastRow, 8) = Me.ComboBox86
            Cells(iLastRow, 9) = Me.ComboBox89
            Cells(iLastRow, 10) = Me.TextBox62
            Cells(iLastRow, 11) = Me.ComboBox90
            Cells(iLastRow, 12) = Me.TextBox63
'конец бллока Лист_8
'блок Лист_9
        Case Is = 8
            On Error Resume Next
            Cells(iLastRow, 4) = 1
            Cells(iLastRow, 4) = Cells(iLastRow - 1, 4) + 1
            Cells(iLastRow, 1) = Me.TextBox67 & " " & Me.TextBox68 & " " & Me.TextBox69
            Cells(iLastRow, 2) = Me.TextBox70
            Cells(iLastRow, 3) = Me.TextBox65
            Cells(iLastRow, 5) = Me.ComboBox98
            Cells(iLastRow, 6) = Me.ComboBox92
            Cells(iLastRow, 7) = Me.ComboBox93
            Cells(iLastRow, 8) = Me.ComboBox96
            Cells(iLastRow, 9) = Me.ComboBox97
            Cells(iLastRow, 10) = Me.ComboBox91
            Cells(iLastRow, 11) = Me.TextBox66
            Cells(iLastRow, 12) = Me.ComboBox94
            Cells(iLastRow, 13) = Me.ComboBox95
            If CheckBox6.Value = True Then
                Cells(iLastRow, 17) = "принят"
                CheckBox6.Enabled = False
            End If
'конец блока Лист_9
        
        End Select
    
        For Each cT In Controls
            Select Case TypeName(cT)
                Case "TextBox", "ComboBox":    cT = ""
            End Select
        Next
        MsgBox "Информация добавлена!", vbInformation, "База"
End Sub

Аналогично работает кнопка редактировать, за исключением переменной ILstRow, для нее используется значение выбранной строки. Можно ли как то сократить код, или это оптимальный вариант?
Зы. В связи с правилами корпоративной этики файл не могу приложить предварительно не очистив названия всех элементов формы, а это очееенб большой объем, больше сотни лейблов .

Kulibinslovoru Пользователь Сообщений: 77 Регистрация: 18.01.2020	#2 23.01.2020 21:20:51 Я гуманитарий, а не технарь, лет 10 назад немного кодил на питоне, а вот сейчас приспичило поработать с VBA. МОжет все гораздо проще чем я думаю, но уже просто голова кипит от прочитанного в поисках решния

vikttur

Пользователь

Сообщений: 47199 Регистрация: 15.09.2012

23.01.2020 21:41:55

Эта ветка для помощи по кокретным вопросам. Здесь тема с таким названием - под удаление (см. правила форума). Есть несколько путей:
определиться и предложить модераторам для переименования новое название (по одной конкретной проблеме);
разместить заказ в платной ветке;
самостоятельно, потихонечку разбираться.

Kulibinslovoru

Пользователь

Сообщений: 77 Регистрация: 18.01.2020

23.01.2020 21:50:41

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

Anchoret

Пользователь

Сообщений: 1065 Регистрация: 01.01.1970

Anchoret

24.01.2020 04:48:29

Код

        aa = Array(Me.TextBox1 & " " & Me.TextBox2 & " " & Me.TextBox3, Me.TextBox4, Me.TextBox5, _
        2, Me.ComboBox4, Me.ComboBox2, Me.ComboBox3, Me.ComboBox7, Me.ComboBox8, Me.ComboBox1, Me.TextBox6, Me.ComboBox5, Me.ComboBox6)
        For a = 0 To UBound(aa): Cells(iLastRow, a + 1) = aa(a): Next

Как пример по обнародованному участку кода.

Nordheim Пользователь Сообщений: 3154 Регистрация: 18.04.2017	#6 24.01.2020 08:35:16 Аж страшно посмотреть на такую форму, та столько контролов . Код сложно оптимизировать не видя самой формы, тут думаю нужно начинать с нее. "Все гениальное просто, а все простое гениально!!!"

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14895 Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

24.01.2020 09:49:30

Цитата
Kulibinslovoru написал: не очистив названия всех элементов формы

странная корпоративная этика, которая требует не передавать третьим лицам UserForm с контролом типа TextBox69...Вы точно имели ввиду названия элементов форм, а не их содержание? Так содержание всегда можно заменить, оставив одну строку данных, в которых вместо гранат и ракет бананы и апельсины. Было бы желание...
А так с виду все выглядит без намека на особую оптимизацию(Anchoret уже предложил все, что можно на основании одного только кода).

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

Kulibinslovoru

Пользователь

Сообщений: 77 Регистрация: 18.01.2020

24.01.2020 13:01:39

Дмитрий(The_Prist) Щербаков,
У каждого Textbox и прочее подписан лейбл, и плюс есть лист на котором хранятся все именованные диапазоны используемые Combobox и формулами считающими статистику. Так что я имел в ввиду и названия и содержание форм.
Nordheim,
Да не страшная она, 9 страниц Multipage привязаны к листам, на каждой страницы по несколько элементов. Разные направления работы, т.е. показатели по ним разносятся по разным листам.

Kulibinslovoru Пользователь Сообщений: 77 Регистрация: 18.01.2020	#9 24.01.2020 13:08:15 Попробую я выложить сюда форму, но позже