Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Возможно ли сократить код?
 
#1
27.09.2011 03:39:56
Здравствуйте!  
В коде формы есть такие строки:  
 
Private Sub AktSeals1_Change()  
Proverka  
End Sub  
 
Private Sub AktSeals2_hange()  
Proverka  
End Sub  
 
....  
 
Private Sub AktSeals40_Change()  
Proverka  
End Sub  
 
Еще такие:  
 
Private Sub AktSeals1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)  
If (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0  
End Sub  
 
Private Sub AktSeals2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)  
If (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0  
End Sub  
 
.....  
 
Private Sub AktSeals40_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)  
If (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0  
End Sub  
 
Возможно ли написать этот код сокращенно  
 
Спасибо.
 
 
 
#2
27.09.2011 06:14:27
Как говорят программисты, любой код можно сократить как минимум на одну строчку.
 
 
 
#3
27.09.2011 06:50:05
Почитайте про классы. Примеры с классами здесь:  
 
http://www.excelworld.ru/forum/3-612-1 и здесь:  
http://www.excelworld.ru/forum/3-591-1
 
 
 
#4
27.09.2011 07:18:33
Сократить можно. Например, так:  
 
Private Sub AktSeals1_Change():Proverka:End Sub  
Private Sub AktSeals2_Change():Proverka:End Sub  
Private Sub AktSeals3_Change():Proverka:End Sub  
...  
Private Sub AktSeals40_Change():Proverka:End Sub  
 
Намного короче получится )  
 
 
Конечно, можно оптимизировать (сократить) код с использованием классов,    
но нучше-то работать не станет  
(это имеет смысл делать в том случае, если кол-во полей будет увеличиваться, или проверки усложняться)
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#5
27.09.2011 21:01:30
Спасибо, тема закрыта
 
 
 
#6
27.09.2011 21:05:41
Тема закрыта
 
 
 
#7
28.09.2011 02:18:39
))) никак не сократиться?  
Private Sub CommandButton1_Click()    'OK  
   Dim iLastRow As Long  
   Selection.Value = Me.TextBox9    'название  
   Selection.Offset(, 1).Value = CDbl(Me.TextBox32)   'закупка  
   Selection.Offset(, 2).Value = CDbl(Me.TextBox6)    'цена  
   Selection.Offset(, 3).Value = Val(Me.TextBox30)    'остаток  
    If Val(Me.TextBox4) > Empty Then  
    Selection.Offset(, 5).Value = "МРБ"  
    Else  
     Selection.Offset(, 5).Value = Me.Label12     'где  
    End If  
If Me.Label12.Caption = "РБ" Then  
       If Val(Me.TextBox4) > Empty Then  
       With Sheets("Магазин")  
   Set r = .Range(.[b2], .Range("B" & .Rows.Count).End(xlUp))
   End With  
   Set x = r.Find(What:=TextBox9.Value, LookAt:=xlWhole)  
   If Not x Is Nothing Then  
   x.Offset(, 3).Value = x.Offset(, 3).Value + Val(Me.TextBox4)  
   x.Offset(, 5).Value = "МРБ"  
     
             With Sheets(2)  
                iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1  
            .Cells(iLastRow, 1) = Me.TextBox34      'дата  
            .Cells(iLastRow, 2) = x.Offset(, -1)      '№  
            .Cells(iLastRow, 3) = Me.TextBox9    'название  
            .Cells(iLastRow, 4) = Val(Me.TextBox4)    'приход  
            .Cells(iLastRow, 6) = CDbl(Me.TextBox6)    'цена  
            .Cells(iLastRow, 7) = Val(Me.TextBox3)     'скидка  
            .Cells(iLastRow, 8) = CDbl(Me.TextBox10)   'сумма  
            .Cells(iLastRow, 9) = Val(Me.TextBox10) - Val(Me.TextBox2) * Val(Me.TextBox32)    'прибыль=сумма(продано)-продано*закупка  
            .Cells(iLastRow, 10) = "из реализации"     'перемещение  
            .Cells(iLastRow, 11) = Val(Me.TextBox4)    'остаток  
            .Cells(iLastRow, 13) = "МРБ"    'где  
               
             With Sheets(8)  
             iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1  
            .Cells(iLastRow, 1) = Me.TextBox34      'дата  
            .Cells(iLastRow, 2) = Val(Me.TextBox31)    '№  
            .Cells(iLastRow, 3) = Me.TextBox9    'название  
            .Cells(iLastRow, 4) = Val(Me.TextBox1)    'приход  
            .Cells(iLastRow, 5) = Val(Me.TextBox2)    'продано  
            .Cells(iLastRow, 6) = CDbl(Me.TextBox6)    'цена  
            .Cells(iLastRow, 7) = Val(Me.TextBox3)     'скидка  
            .Cells(iLastRow, 8) = CDbl(Me.TextBox10)    'сумма  
            .Cells(iLastRow, 9) = Val(Me.TextBox10) - Val(Me.TextBox2) * Val(Me.TextBox32)    'прибыль=сумма(продано)-продано*закупка  
            .Cells(iLastRow, 10) = "в магазин   " & Val(Me.TextBox4) & "шт"     'перемещение  
            .Cells(iLastRow, 11) = Val(Me.TextBox30)    'остаток  
            If Val(Me.TextBox33) > 0 Then  
            .Cells(iLastRow, 12) = "ВОЗВРАТ    " & Val(Me.TextBox33)         'возврат  
            Else  
            End If  
            .Cells(iLastRow, 13) = "МРБ"    'где  
             End With  
             End With  
     ElseIf x Is Nothing Then  
             With Sheets(1)  
               iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1  
            .Cells(iLastRow, 1).Value = Application.Max(Sheets(1).Columns(1)) + 1 '№  
            .Cells(iLastRow, 2).Value = Me.TextBox9         'название  
            .Cells(iLastRow, 3).Value = CDbl(Me.TextBox32) 'закупка  
            .Cells(iLastRow, 4).Value = CDbl(Me.TextBox6)   'цена  
            .Cells(iLastRow, 5).Value = Val(Me.TextBox4)   'остаток  
            .Cells(iLastRow, 7).Value = "МРБ"        'где  
               
             With Sheets(2)  
                iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1  
            .Cells(iLastRow, 1) = Me.TextBox34      'дата  
            .Cells(iLastRow, 2) = Application.Max(Sheets(1).Columns(1))      '№  
            .Cells(iLastRow, 3) = Me.TextBox9    'название  
            .Cells(iLastRow, 4) = Val(Me.TextBox4)    'приход  
            .Cells(iLastRow, 6) = CDbl(Me.TextBox6)    'цена  
            .Cells(iLastRow, 7) = Val(Me.TextBox3)     'скидка  
            .Cells(iLastRow, 8) = CDbl(Me.TextBox10)   'сумма  
            .Cells(iLastRow, 9) = Val(Me.TextBox10) - Val(Me.TextBox2) * Val(Me.TextBox32)    'прибыль=сумма(продано)-продано*закупка  
            .Cells(iLastRow, 10) = "из реализации"     'перемещение  
            .Cells(iLastRow, 11) = Val(Me.TextBox4)    'остаток  
            .Cells(iLastRow, 13) = "МРБ"    'где  
               
             With Sheets(8)  
             iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1  
            .Cells(iLastRow, 1) = Me.TextBox34      'дата  
            .Cells(iLastRow, 2) = Val(Me.TextBox31)    '№  
            .Cells(iLastRow, 3) = Me.TextBox9    'название  
            .Cells(iLastRow, 4) = Val(Me.TextBox1)    'приход  
            .Cells(iLastRow, 5) = Val(Me.TextBox2)    'продано  
            .Cells(iLastRow, 6) = CDbl(Me.TextBox6)    'цена  
            .Cells(iLastRow, 7) = Val(Me.TextBox3)     'скидка  
            .Cells(iLastRow, 8) = CDbl(Me.TextBox10)    'сумма  
            .Cells(iLastRow, 9) = Val(Me.TextBox10) - Val(Me.TextBox2) * Val(Me.TextBox32)    'прибыль=сумма(продано)-продано*закупка  
            .Cells(iLastRow, 10) = "в магазин   " & Val(Me.TextBox4) & "шт"     'перемещение  
            .Cells(iLastRow, 11) = Val(Me.TextBox30)    'остаток  
            If Val(Me.TextBox33) > 0 Then  
            .Cells(iLastRow, 12) = "ВОЗВРАТ    " & Val(Me.TextBox33)         'возврат  
            Else  
            End If  
            .Cells(iLastRow, 13) = "МРБ"    'где  
             End With  
             End With  
             End With  
             End If  
       ElseIf Val(Me.TextBox4) = Empty Then  
              With Sheets(8)  
             iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1  
            .Cells(iLastRow, 1) = Me.TextBox34      'дата  
            .Cells(iLastRow, 2) = Val(Me.TextBox31)    '№  
            .Cells(iLastRow, 3) = Me.TextBox9    'название  
            .Cells(iLastRow, 4) = Val(Me.TextBox1)    'приход  
            .Cells(iLastRow, 5) = Val(Me.TextBox2)    'продано  
            .Cells(iLastRow, 6) = CDbl(Me.TextBox6)    'цена  
            .Cells(iLastRow, 7) = Val(Me.TextBox3)     'скидка  
            .Cells(iLastRow, 8) = CDbl(Me.TextBox10)    'сумма  
            .Cells(iLastRow, 9) = Val(Me.TextBox10) - Val(Me.TextBox2) * Val(Me.TextBox32)    'прибыль=сумма(продано)-продано*закупка  
            .Cells(iLastRow, 10) = Val(Me.TextBox4)     'перемещение  
            .Cells(iLastRow, 11) = Val(Me.TextBox30)    'остаток  
            If Val(Me.TextBox33) > 0 Then  
            .Cells(iLastRow, 12) = "ВОЗВРАТ    " & Val(Me.TextBox33)         'возврат  
            Else  
            End If  
            .Cells(iLastRow, 13) = "РБ"    'где  
          End With  
          End If  
          End If  
If Me.Label12.Caption = "МРБ" Then  
  With Sheets("Магазин")  
   Set r = .Range(.[b2], .Range("B" & .Rows.Count).End(xlUp))
   End With  
   Set x = r.Find(What:=TextBox9.Value, LookAt:=xlWhole)  
   If Not x Is Nothing Then  
   x.Offset(, 3).Value = x.Offset(, 3).Value + Val(Me.TextBox4)  
   ElseIf Me.TextBox4.Value = Empty Then  
   End If  
   If Me.TextBox4 > Empty Then  
  With Sheets(2)  
         iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1  
       .Cells(iLastRow, 1) = Me.TextBox34         'дата  
       .Cells(iLastRow, 2) = x.Offset(, -1)       '№  
       .Cells(iLastRow, 3) = Me.TextBox9          'название  
       .Cells(iLastRow, 4) = Val(Me.TextBox4)     'приход  
       .Cells(iLastRow, 6) = CDbl(Me.TextBox6)    'цена  
       .Cells(iLastRow, 7) = Val(Me.TextBox3)     'скидка  
       .Cells(iLastRow, 8) = CDbl(Me.TextBox10)   'сумма  
       .Cells(iLastRow, 9) = Val(Me.TextBox10) - Val(Me.TextBox2) * Val(Me.TextBox32)  'прибыль  
        If Val(Me.TextBox4) > 0 Then  
         .Cells(iLastRow, 10) = "из реализации"   'перемещение  
         Else  
        .Cells(iLastRow, 10) = Val(Me.TextBox4)  
        End If  
        .Cells(iLastRow, 11) = x.Offset(, 3).Value    'остаток  
        .Cells(iLastRow, 13) = Me.Label12  
     
  With Sheets(8)  
        iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1  
       .Cells(iLastRow, 1) = Me.TextBox34      'дата  
       .Cells(iLastRow, 2) = Val(Me.TextBox31)    '№  
       .Cells(iLastRow, 3) = Me.TextBox9    'название  
       .Cells(iLastRow, 4) = Val(Me.TextBox1)    'приход  
       .Cells(iLastRow, 5) = Val(Me.TextBox2)    'продано  
       .Cells(iLastRow, 6) = CDbl(Me.TextBox6)    'цена  
       .Cells(iLastRow, 7) = Val(Me.TextBox3)     'скидка  
       .Cells(iLastRow, 8) = CDbl(Me.TextBox10)    'сумма  
       .Cells(iLastRow, 9) = Val(Me.TextBox10) - Val(Me.TextBox2) * Val(Me.TextBox32)    'прибыль=сумма(продано)-продано*закупка  
        If Val(Me.TextBox4) > Empty Then  
         .Cells(iLastRow, 10) = "в магазин    " & Val(Me.TextBox4) & "шт" 'перемещение  
         Else  
         .Cells(iLastRow, 10) = Val(Me.TextBox4)  'перемещение  
        End If  
         .Cells(iLastRow, 11) = Val(Me.TextBox30)    'остаток  
       If Val(Me.TextBox33) > Empty Then  
         .Cells(iLastRow, 12) = "ВОЗВРАТ    " & Val(Me.TextBox33)         'возврат  
       End If  
         .Cells(iLastRow, 13) = Me.Label12    'где  
  End With  
  End With  
  ElseIf Me.TextBox4 = Empty Then  
           With Sheets(8)  
        iLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1  
       .Cells(iLastRow, 1) = Me.TextBox34      'дата  
       .Cells(iLastRow, 2) = Val(Me.TextBox31)    '№  
       .Cells(iLastRow, 3) = Me.TextBox9    'название  
       .Cells(iLastRow, 4) = Val(Me.TextBox1)    'приход  
       .Cells(iLastRow, 5) = Val(Me.TextBox2)    'продано  
       .Cells(iLastRow, 6) = CDbl(Me.TextBox6)    'цена  
       .Cells(iLastRow, 7) = Val(Me.TextBox3)     'скидка  
       .Cells(iLastRow, 8) = CDbl(Me.TextBox10)    'сумма  
       .Cells(iLastRow, 9) = Val(Me.TextBox10) - Val(Me.TextBox2) * Val(Me.TextBox32)    'прибыль=сумма(продано)-продано*закупка  
        If Val(Me.TextBox4) > Empty Then  
         .Cells(iLastRow, 10) = "в магазин    " & Val(Me.TextBox4) & "шт" 'перемещение  
         Else  
         .Cells(iLastRow, 10) = Val(Me.TextBox4)  'перемещение  
        End If  
         .Cells(iLastRow, 11) = Val(Me.TextBox30)    'остаток  
       If Val(Me.TextBox33) > 0 Then  
            .Cells(iLastRow, 12) = "ВОЗВРАТ    " & Val(Me.TextBox33)         'возврат  
            Else  
            End If  
         .Cells(iLastRow, 13) = Me.Label12    'где  
  End With  
  End If  
End If  
Call hidenrows.HideRows  
Unload Me  
End Sub
 
 
 
#8
28.09.2011 08:07:42
{quote}{login=AKSENOV048}{date=28.09.2011 02:18}{thema="Как говорят программисты, любой код можно сократить как минимум на одну строчку."}{post}))) никак не сократиться?  
Private Sub CommandButton1_Click()    'OK  
   Dim iLastRow As Long  
   ... и т.д. ...  
   Unload Me  
End Sub{/post}{/quote}  
Да, вот именно.  
МОжно сократить как минимум на 1 строчку.  
Очевидно, что это - всего лишь шутка. Но Ваш код - точно можно сократить какминимум на несколько строчек. Читабельнее он от этого, ессно, не станет. Но, повторюсь, это - всего лишь шутка. А краткость - сестра таланта, но дочка лени и часто мать неразберихи.  
 
НАПРИМЕР (sheets(8), строка где-то 12):  
 
If Val(Me.TextBox33) > 0 Then  
.Cells(iLastRow, 12) = "ВОЗВРАТ " & Val(Me.TextBox33) 'возврат  
Else  
End If  
 
сокращаем на 1 строку  
 
If Val(Me.TextBox33) > 0 Then  
.Cells(iLastRow, 12) = "ВОЗВРАТ " & Val(Me.TextBox33) 'возврат  
End If  
 
сокращаем еще на 1 строку  
 
If Val(Me.TextBox33) > 0 Then .Cells(iLastRow, 12) = "ВОЗВРАТ " & Val(Me.TextBox33) 'возврат
 
 
 
#9
28.09.2011 11:25:39
))спасибо. (я тоже пошутил))
 
 
 
#10
28.09.2011 11:50:26
Начну по порядку:  
 
1. Selection - а если пользователь не проверит где курсор стоит и выделена не одна ячейка? Выгрузит кашу. Нет проверки, не профессионально.  
2. Конструкцию With для листов не надо делать вложенной.  
3.Удивило Val(Me.TextBox4) > Empty    
4. Условие ElseIf Me.TextBox4 = Empty Then продублировано.  
5. строка .Cells(iLastRow, 1) = Me.TextBox34 'дата прописана во всех условиях  
если нет разницы зачем пихать в условие? Пропишите один раз после или до условия.  
6. То же и для .Cells(iLastRow, 3) = Me.TextBox9 'название
 
 
 
#11
28.09.2011 12:00:21
там все правильно, просто здесь не полный код, поэтому может показаться что то не правильным.
 
 
 
#12
28.09.2011 12:25:06
>>1. Selection - а если пользователь не проверит где курсор стоит и выделена не одна ячейка? Выгрузит кашу. Нет проверки, не профессионально.  
Мне кажется Selection - эт вообще отдельная тема. Но тем не менее Уважаемый VovaK прав : )
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук

https://github.com/nervgh
 
 
 
#13
28.09.2011 12:56:42
А мне кажется, что тут Selection ставилось формой, т.е. не будет двух ячеек и не там. А форма не даёт по листу лазить. А CommandButton1 тоже на форме :)
 
 
 
Страницы: 1
Читают тему
Наверх