Проблема с VBA в Exсel при написании формы

Вопросы по программированию, не подходящие в другие разделы.

Модераторы: Naeel Maqsudov, C_O_D_E

Ответить
Anasi
Сообщения: 5
Зарегистрирован: 27 июн 2008, 12:20

Помогите пожалуйста!
У меня возникла проблема с написанием кода к форме для расчетов в Exсel...

Мне нужно создать раскрываюшийся список на форме из N изделий (причем в книге Exсel сушествует два листа: 1- лист с пустыми таблицами и формулами для рассчетов: 2- содержит начальные данные для расчета (исходные парпметры изделия)), причем, когда N-ное изделие выбирается в форме необходимо что-бы его иходные данные автоматически переносилисьс листа2 на лист 1... (в определенные ячейки)Как это сделать....

я пробоволда прописать так:

Private Sub nomenclature1_Change()
'добавление номенклатуры

If UserForm1.ComboBox1.Value = "изделие 1" Then
Worksheets(1).Range("G5") = Worksheets(2).Range("G6")
Worksheets(1).Range("G6") = Worksheets(2).Range("G7")
Worksheets(1).Range("G7") = Worksheets(2).Range("G8")
End If

If UserForm1.ComboBox1.Value = "изделие 2" Then
Worksheets(1).Range("H5") = Worksheets(2).Range("H6")
Worksheets(1).Range("H6") = Worksheets(2).Range("H7")
Worksheets(1).Range("H7") = Worksheets(2).Range("H8")
End If
End Sub


Помогите пожалуйста....я не знаю как правильно это сделать...=(((((( :confused: :(
Вернуться к началу
Аватара пользователя
VictorM
Сообщения: 794
Зарегистрирован: 23 окт 2006, 01:44
Откуда: Lugansk, Ukraine
Контактная информация:
Контактная информация пользователя VictorM

Сделать можно, в Вашем коде сразу видны ошибки,но желательно бы файлик Ваш с данными и формой.
А то как-то влом с нуля самому набирать.
"Дайте людям рыбы, и вы накормите их на весь день;
научите их ловить рыбу - и вы накормите их на всю жизнь".
Вернуться к началу
Anasi
Сообщения: 5
Зарегистрирован: 27 июн 2008, 12:20

VictorM, а какие ошибки????
Вернуться к началу
Аватара пользователя
VictorM
Сообщения: 794
Зарегистрирован: 23 окт 2006, 01:44
Откуда: Lugansk, Ukraine
Контактная информация:
Контактная информация пользователя VictorM

VictorM писал(а): в Вашем коде сразу видны ошибки,но желательно бы файлик Ваш с данными и формой.

Anasi
VictorM, а какие ошибки????
да, собственно, насчет ошибок я видимо "погорячился" , просто непривычно написано.
Прошу меня извинить.
Не дождавшись Вашего файла проверил то, что Вами написано и... все работает.
Так что мне не понятна суть Вашей проблемы :confused: (этот код работает)
Скорее всего, без Вашего файла мы не сможем понять друг друга и я не смогу Вам помочь.
"Дайте людям рыбы, и вы накормите их на весь день;
научите их ловить рыбу - и вы накормите их на всю жизнь".
Вернуться к началу
Anasi
Сообщения: 5
Зарегистрирован: 27 июн 2008, 12:20

VictorM,я включаю форму на просмотр и ничего не отображается в списке.....=((( грустно от этого до ужаса....я вот теперь думаю, может комп глюкает...=//
Вернуться к началу
Аватара пользователя
VictorM
Сообщения: 794
Зарегистрирован: 23 окт 2006, 01:44
Откуда: Lugansk, Ukraine
Контактная информация:
Контактная информация пользователя VictorM

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

Код: Выделить всё

Private Sub UserForm_Activate()
ComboBox1.RowSource = "изделие" ' именованный диапазон (источник данных)
End Sub
а дальше Ваш код. И все работает.
"Дайте людям рыбы, и вы накормите их на весь день;
научите их ловить рыбу - и вы накормите их на всю жизнь".
Вернуться к началу
Anasi
Сообщения: 5
Зарегистрирован: 27 июн 2008, 12:20

все равно не пашет.....

вот весь исходинк...


Private Sub Criterion5_Change()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label12_Click()

End Sub

Private Sub Label16_Click()

End Sub

Private Sub Label7_Click()

End Sub

Private Sub Label9_Click()

End Sub

Private Sub nomenclature1_Click()
If UserForm1.nomenclature1.Value = "изделие1 Then
Worksheets(1).Range("G5") = Worksheets(2).Range("G6")
Worksheets(1).Range("G6") = Worksheets(2).Range("G7")
Worksheets(1).Range("G7") = Worksheets(2).Range("G8")
Worksheets(1).Range("G8") = Worksheets(2).Range("G9")
Worksheets(1).Range("G9") = Worksheets(2).Range("G10")
Worksheets(1).Range("G10") = Worksheets(2).Range("G11")
Worksheets(1).Range("G11") = Worksheets(2).Range("G12")
Worksheets(1).Range("G12") = Worksheets(2).Range("G13")
Worksheets(1).Range("G13") = Worksheets(2).Range("G14")
Worksheets(1).Range("G14") = Worksheets(2).Range("G15")
Worksheets(1).Range("G15") = Worksheets(2).Range("G16")
Worksheets(1).Range("G16") = Worksheets(2).Range("G17")
Worksheets(1).Range("G17") = Worksheets(2).Range("G18")
Worksheets(1).Range("G18") = Worksheets(2).Range("G19")
Worksheets(1).Range("G19") = Worksheets(2).Range("G20")
End If

If UserForm1.nomenclature1.Value = "изделие2" Then
Worksheets(1).Range("H5") = Worksheets(2).Range("H6")
Worksheets(1).Range("H6") = Worksheets(2).Range("H7")
Worksheets(1).Range("H7") = Worksheets(2).Range("H8")
Worksheets(1).Range("H8") = Worksheets(2).Range("H9")
Worksheets(1).Range("H9") = Worksheets(2).Range("H10")
Worksheets(1).Range("H10") = Worksheets(2).Range("H11")
Worksheets(1).Range("H11") = Worksheets(2).Range("H12")
Worksheets(1).Range("H12") = Worksheets(2).Range("H13")
Worksheets(1).Range("H13") = Worksheets(2).Range("H14")
Worksheets(1).Range("H14") = Worksheets(2).Range("H15")
Worksheets(1).Range("H15") = Worksheets(2).Range("H16")
Worksheets(1).Range("H16") = Worksheets(2).Range("H17")
Worksheets(1).Range("H17") = Worksheets(2).Range("H18")
Worksheets(1).Range("H18") = Worksheets(2).Range("H19")
Worksheets(1).Range("H19") = Worksheets(2).Range("H20")
End If

If UserForm1.nomenclature1.Value = "изделие 3" Then
Worksheets(1).Range("I5") = Worksheets(2).Range("I6")
Worksheets(1).Range("I6") = Worksheets(2).Range("I7")
Worksheets(1).Range("I7") = Worksheets(2).Range("I8")
Worksheets(1).Range("I8") = Worksheets(2).Range("I9")
Worksheets(1).Range("I9") = Worksheets(2).Range("I10")
Worksheets(1).Range("I10") = Worksheets(2).Range("I11")
Worksheets(1).Range("I11") = Worksheets(2).Range("I12")
Worksheets(1).Range("I12") = Worksheets(2).Range("I13")
Worksheets(1).Range("I13") = Worksheets(2).Range("I14")
Worksheets(1).Range("I14") = Worksheets(2).Range("I15")
Worksheets(1).Range("I15") = Worksheets(2).Range("I16")
Worksheets(1).Range("I16") = Worksheets(2).Range("I17")
Worksheets(1).Range("I17") = Worksheets(2).Range("I18")
Worksheets(1).Range("I18") = Worksheets(2).Range("I19")
Worksheets(1).Range("I19") = Worksheets(2).Range("I20")
End If

If UserForm1.nomenclature1.Value = "изделие 4" Then
Worksheets(1).Range("J5") = Worksheets(2).Range("J6")
Worksheets(1).Range("J6") = Worksheets(2).Range("J7")
Worksheets(1).Range("J7") = Worksheets(2).Range("J8")
Worksheets(1).Range("J8") = Worksheets(2).Range("J9")
Worksheets(1).Range("J9") = Worksheets(2).Range("J10")
Worksheets(1).Range("J10") = Worksheets(2).Range("J11")
Worksheets(1).Range("J11") = Worksheets(2).Range("J12")
Worksheets(1).Range("J12") = Worksheets(2).Range("J13")
Worksheets(1).Range("J13") = Worksheets(2).Range("J14")
Worksheets(1).Range("J14") = Worksheets(2).Range("J15")
Worksheets(1).Range("J15") = Worksheets(2).Range("J16")
Worksheets(1).Range("J16") = Worksheets(2).Range("J17")
Worksheets(1).Range("J17") = Worksheets(2).Range("J18")
Worksheets(1).Range("J18") = Worksheets(2).Range("J19")
Worksheets(1).Range("J19") = Worksheets(2).Range("J20")
End If
End Sub

Private Sub nomenclature2_Change()

End Sub

Private Sub nomenclature3_Change()

End Sub

Private Sub nomenclature4_Change()

End Sub

Private Sub quantity1_Change()

End Sub

Private Sub quantity2_Change()

End Sub

Private Sub quantity3_Change()

End Sub

Private Sub quantity4_Change()

End Sub


=(((((поствила как вы сказали, все равно не пашет...
Вернуться к началу
Аватара пользователя
VictorM
Сообщения: 794
Зарегистрирован: 23 окт 2006, 01:44
Откуда: Lugansk, Ukraine
Контактная информация:
Контактная информация пользователя VictorM

Anasi, чёт мы никак не поймем друг друга :confused:
Ваш код мне ни о чем не говорит.
Вижу кучу лишних Sub и выбор значений в ComboBox.
Если Вы хотите, чтобы я мог Вам реально помочь и что-то подсказать, мне нужен Ваш файл.
Если Вы не можете его прикрепить, напишите мне в личку и я скажу куда его выслать (если это конечно не гос. тайна :) )
"Дайте людям рыбы, и вы накормите их на весь день;
научите их ловить рыбу - и вы накормите их на всю жизнь".
Вернуться к началу
Аватара пользователя
VictorM
Сообщения: 794
Зарегистрирован: 23 окт 2006, 01:44
Откуда: Lugansk, Ukraine
Контактная информация:
Контактная информация пользователя VictorM

В дополнение к высланному файлу. Ваш код можно значительно упростить.
Вот так, если оставить Ваши If

Код: Выделить всё

Private Sub ComboBox1_Change()
If Me.ComboBox1.Value = "конфета 1" Then
    Worksheets(2).Range("G6:G20").Copy Destination:=Worksheets(1).Range("G5")
ElseIf Me.ComboBox1.Value = "конфета 2" Then
    Worksheets(2).Range("H6:H20").Copy Destination:=Worksheets(1).Range("H5")
ElseIf Me.ComboBox1.Value = "конфета 3" Then
    Worksheets(2).Range("I6:I20").Copy Destination:=Worksheets(1).Range("I5")
ElseIf Me.ComboBox1.Value = "конфета 4" Then
    Worksheets(2).Range("J6:J20").Copy Destination:=Worksheets(1).Range("J5")
End If
End Sub
а еще лучше так:

Код: Выделить всё

Private Sub ComboBox1_Change()
 Select Case ComboBox1.Value
    Case "конфета 1"
        Worksheets(2).Range("G6:G20").Copy Destination:=Worksheets(1).Range("G5")
    Case "конфета 2"
        Worksheets(2).Range("H6:H20").Copy Destination:=Worksheets(1).Range("H5")
    Case "конфета 3"
        Worksheets(2).Range("I6:I20").Copy Destination:=Worksheets(1).Range("I5")
    Case "конфета 4"
        Worksheets(2).Range("J6:J20").Copy Destination:=Worksheets(1).Range("J5")
End Select
End Sub
или же использовать ListIndex и написать так:

Код: Выделить всё

Private Sub ComboBox1_Change()
 Select Case ComboBox1.ListIndex
    Case 0
        Worksheets(2).Range("G6:G20").Copy Destination:=Worksheets(1).Range("G5")
    Case 1
        Worksheets(2).Range("H6:H20").Copy Destination:=Worksheets(1).Range("H5")
    Case 2
        Worksheets(2).Range("I6:I20").Copy Destination:=Worksheets(1).Range("I5")
    Case 3
        Worksheets(2).Range("J6:J20").Copy Destination:=Worksheets(1).Range("J5")
End Select
End Sub
где Ваши "конфета 1,2,3,4" заменены индексом строки бокса, т.е.

Код: Выделить всё

With ComboBox1
    .AddItem "конфета 1" 'ListIndex = 0
    .AddItem "конфета 2" 'ListIndex = 1
    .AddItem "конфета 3" 'ListIndex = 2
    .AddItem "конфета 4" 'ListIndex = 3
End With
как видите, варианты есть, выбирайте, что Вам более подходит для выполнения Вашей задачи.
"Дайте людям рыбы, и вы накормите их на весь день;
научите их ловить рыбу - и вы накормите их на всю жизнь".
Вернуться к началу
Anasi
Сообщения: 5
Зарегистрирован: 27 июн 2008, 12:20

Спасибо...сейчас попробую=)))
Вернуться к началу
Ответить

Вернуться в «Вопрошайка»