Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » AranyHunter
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Макрос фильтр для создания прайс листа
 
#
09.12.2015 20:15:57
И еще раз доброго времени суток!
Помогите пожалуйста написать макрос фильтр для формирования прайс листа, в новом листе прайс
Данные берутся с листа "Курятники" : Порода (столбец B), окрас (столбец C), Цена инкубационного яйца за шт. (столбец I), Цена суточного цыпленка за шт. (столбец J), Цена недельного цыпленка (столбец K), Цена двухнедельного цыпленка за шт. (столбец L), Цена трехнедельного цыпленка за шт. (столбец M), Цена месячного цыпленка за шт. (столбец N)
Копируются в одноимённые столбцы, но порода и окрас в одном столбце B, а нумерация в столбце А (только на против окраса)
Пример:
Амераукана
1 белый
2 дикий
Фавероль
3 лососевый
Кохинхин
4 голубой, черный
5 золотистый черно-окаймленный
6 серебряный черно-окаймленный
7 черный мрамор
8 белый

Пример формы заполнения вложил (Лист "прайс лист") и базы
Изменено: AranyHunter - 10.12.2015 00:45:59
 
Перейти    
Макрос нумератор
 
#
09.12.2015 15:14:17
Наверное я уже всех достал, но я еще только учусь и пытаюсь разобраться методами научного тыка и консультаций, и вашей помощи
Возник вопрос с автонумератором с столбца.
Нужно что бы в столбце A вставлялся порядковый номер 1,2,3,4 и так далее при заполнение UserForm
вот код
Код
Private Sub CommandButton1_Click()
 EmptyRows = WorksheetFunction.CountA(Range("B:B")) + 1

If ComboBox1.ListIndex = -1 Then Worksheets("Породы гнезда").Cells(Worksheets("Породы гнезда").Cells(Rows.Count, "B1:B").End(xlUp).Row + 1, "B").Value = ComboBox1.Value
 Cells(EmptyRows, 2) = ComboBox1.Value

If ComboBox2.ListIndex = -1 Then Worksheets("Окрасы").Cells(Worksheets("Окрасы").Cells(Rows.Count, "C1:C").End(xlUp).Row + 1, "C").Value = ComboBox2.Value
 Cells(EmptyRows, 3) = ComboBox2.Value

If ComboBox3.ListIndex = -1 Then Worksheets("Породы гнезда").Cells(Worksheets("Породы гнезда").Cells(Rows.Count, "D1:D").End(xlUp).Row + 1, "D").Value = ComboBox3.Value
 Cells(EmptyRows, 4) = ComboBox3.Value
 Cells(EmptyRows, 5) = TextBox1.Value 'дата'
 Cells(EmptyRows, 6) = TextBox2.Value 'количество голов'
 Cells(EmptyRows, 7) = TextBox3.Value 'из них кур'
 Cells(EmptyRows, 8) = TextBox2.Value - TextBox3.Value
 Cells(EmptyRows, 9) = TextBox4.Value  'инкубационное яйцо'
 Cells(EmptyRows, 10) = TextBox5.Value 'суточные цыплята'
 Cells(EmptyRows, 11) = TextBox5.Value + 50 'недельные цыплята'
 Cells(EmptyRows, 12) = TextBox5.Value + 100 'двухнедельные цыплята'
 Cells(EmptyRows, 13) = TextBox5.Value + 150 'трехнедельные цыплята'
 Cells(EmptyRows, 14) = TextBox5.Value + 200 'месячные цыплята'
 Cells(EmptyRows, 15) = TextBox5.Value + 400 'двухмесячные цыплята'
 Cells(EmptyRows, 16) = TextBox5.Value + 600 'трехмесячные цыплята'
 Cells(EmptyRows, 17) = TextBox5.Value + 800 'четырехмесячные цыплята'
 UserForm_Initialize
End Sub

Private Sub CommandButton2_Click()
Call UserForm_Initialize
End Sub

Private Sub CommandButton3_Click()
 UserForm1.Hide
End Sub

Private Sub UserForm_Initialize()

 ComboBox1.Clear: ComboBox1.Text = ""

For I = 1 To Worksheets("Породы гнезда").Cells(Rows.Count, "A").End(xlUp).Row
 ComboBox1.AddItem Worksheets("Породы гнезда").Cells(I, "A").Value
Next I

 ComboBox2.Clear: ComboBox2.Text = ""

For I = 1 To Worksheets("Окрасы").Cells(Rows.Count, "A").End(xlUp).Row
 ComboBox2.AddItem Worksheets("Окрасы").Cells(I, "A").Value
Next I

 ComboBox3.Clear
For I = 1 To Worksheets("Породы гнезда").Cells(Rows.Count, "B").End(xlUp).Row
 ComboBox3.AddItem Worksheets("Породы гнезда").Cells(I, "B").Value
Next I
 TextBox1.Text = Format(Now(), "dd.mm.yyyy") 'дата'
 TextBox2.Value = "" 'количество голов'

 TextBox3.Value = "" 'из них кур'

 TextBox4.Value = "" 'цена инкубационного яйца'

 TextBox5.Value = "" 'цена суточного цыпленка'

End Sub
 
Перейти    
combobox 1 и combobox2 можно ли сделать выборку двух значений
 
#
06.12.2015 17:51:52
Доброго времени суток всем гуру программирования!
У меня возникла проблема c combobox
Есть порода, окрасы
Хотелось бы сделать так - выбор породы и окраса в одном combobox, а так же при добавление новых пород и окрасов они записывались в листы окрасы и породы (окрас зависим от порода, т.к пород много и у них много окрасов от этого зависит цена )
Код
ComboBox1.Clear
For I = 1 To Worksheets("Породы").Cells(Rows.Count, "A").End(xlUp).Row
 ComboBox1.AddItem Worksheets("Породы").Cells(I, "A").Value
Next I

 ComboBox2.Clear
For I = 1 To Worksheets("Окрасы").Cells(Rows.Count, "A").End(xlUp).Row
 ComboBox2.AddItem Worksheets("Окрасы").Cells(I, "A").Value
Next I

 ComboBox3.Clear
For I = 1 To Worksheets("Породы").Cells(Rows.Count, "B").End(xlUp).Row
 ComboBox3.AddItem Worksheets("Породы").Cells(I, "B").Value
Next I
 
Перейти    
Макрос в UserForm прибавляющий определенную сумму
 
#
06.12.2015 17:48:18
И еще раз здравствуйте!
есть UserForm при заполнение в ней данных, захотелось расширить ее возможности (что бы в таблице не писать формулы как K2=J2+50, L2=K2+50 и т.д.).
Как сделать что бы при внесение данных в TextBox8 автоматически данные увеличивались на 50 и вносились в столбцы , но столбцов 5 (J, K, L, M, N.) Данные в столбец J вносятся через textbox8, остальные столбцы высчитывались автоматически по формуле K=J+50 J=K+50 L=J+50 M=L+50 N=M+50 (эти формулы неизменны для всех ячеек всего столбца)
 
Перейти    
Макрос, копирующий данные столбца до последней заполенной ячейки
 
#
05.12.2015 16:53:15
Доброго всем времени суток! Я только пытаюсь разобраться с VBA и столкнулся с очень проблемным вопросом (для меня). Суть вопроса% нужен макрос который копировал данные столбца и переносил их на другой лист, но есть условие: он должен копировать данные до последней ячейки (так как данные будут в последствие добавлять)
к Примеру нужно скопировать с list1 столбец В до последней заполненной строки и вставить данные на list2 и так далее
Код
Sub ()
Application.ScreenUpdating = False
Application.CutCopyMode = False
iLastA = Worksheets("List2").Cells(Rows.Count, 1).End(xlUp).Row + 1
iLastB = Worksheets("List2").Cells(Rows.Count, 2).End(xlUp).Row + 1
iLastC = Worksheets("List2").Cells(Rows.Count, 3).End(xlUp).Row + 1

Worksheets("List1").Range("B1:B39").Copy
Worksheets("List2").Range("A" & iLastA).PasteSpecial xlValue
Worksheets("List1").Range("C1:C39").Copy
Worksheets("List2").Range("B" & iLastB).PasteSpecial xlValue
Worksheets("List1").Range("I1:I39").Copy
Worksheets("List2").Range("C" & iLastC).PasteSpecial xlValue
Application.CutCopyMode = True
Application.ScreenUpdating = True
End Sub
 
Перейти    
Страницы: 1
Наверх