Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос нумератор - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос нумератор (Макросы/Sub)
Макрос нумератор
AranyHunter Дата: Среда, 09.12.2015, 14:20 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Наверное я уже всех достал, но я еще только учусь и пытаюсь разобраться методами научного тыка и консультаций, и вашей помощи
Возник вопрос с автонумератором с столбца.
Нужно что бы в столбце A вставлялся порядковый номер 1,2,3,4 и так далее при заполнение UserForm
вот код [vba]
Код
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
[/vba]
 
Ответить
СообщениеНаверное я уже всех достал, но я еще только учусь и пытаюсь разобраться методами научного тыка и консультаций, и вашей помощи
Возник вопрос с автонумератором с столбца.
Нужно что бы в столбце A вставлялся порядковый номер 1,2,3,4 и так далее при заполнение UserForm
вот код [vba]
Код
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
[/vba]
Автор - AranyHunter
Дата добавления - 09.12.2015 в 14:20
devilkurs Дата: Среда, 09.12.2015, 17:43 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010
AranyHunter, в Private Sub CommandButton1_Click() добавьте один из 2-х вариантов

1) Если использовать формулу для нумерации, то
[vba]
Код
Cells(EmptyRows, 1).FormulaR1C1 = "=ROW()-1"
[/vba]
формула вычисляет - текущая строка минус 1 (у Вас же первая строка шапка)

2) через прибавление к предыдущей строке
[vba]
Код
If EmptyRows = 2 Then
    Cells(EmptyRows, 1) = 1 'если первая запись (т.е строка 2) ставим № 1
Else
    Cells(EmptyRows, 1) = Cells(EmptyRows - 1, 1) + 1 'если запись вторая и больше (т.е. строка 3 и больше), то к значению в предыдущей строке прибавляем 1
End If
[/vba]
Здесь плохо, то что при удалении какой либо записи, надо дописывать еще код на перенумерацию. А с формулой автоматически будет пересчитываться.

Кстати, 3 вариант
[vba]
Код

Cells(EmptyRows, 1)= EmptyRows-1
[/vba]
но здесь тоже придется дописывать на перенумерацию.

[p.s.]Нет файла с примером, не проверял что написал



Сообщение отредактировал devilkurs - Среда, 09.12.2015, 17:50
 
Ответить
СообщениеAranyHunter, в Private Sub CommandButton1_Click() добавьте один из 2-х вариантов

1) Если использовать формулу для нумерации, то
[vba]
Код
Cells(EmptyRows, 1).FormulaR1C1 = "=ROW()-1"
[/vba]
формула вычисляет - текущая строка минус 1 (у Вас же первая строка шапка)

2) через прибавление к предыдущей строке
[vba]
Код
If EmptyRows = 2 Then
    Cells(EmptyRows, 1) = 1 'если первая запись (т.е строка 2) ставим № 1
Else
    Cells(EmptyRows, 1) = Cells(EmptyRows - 1, 1) + 1 'если запись вторая и больше (т.е. строка 3 и больше), то к значению в предыдущей строке прибавляем 1
End If
[/vba]
Здесь плохо, то что при удалении какой либо записи, надо дописывать еще код на перенумерацию. А с формулой автоматически будет пересчитываться.

Кстати, 3 вариант
[vba]
Код

Cells(EmptyRows, 1)= EmptyRows-1
[/vba]
но здесь тоже придется дописывать на перенумерацию.

[p.s.]Нет файла с примером, не проверял что написал
Автор - devilkurs
Дата добавления - 09.12.2015 в 17:43
AranyHunter Дата: Среда, 09.12.2015, 18:13 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
devilkurs, Спасибо большое! все получилось)

Цитата devilkurs, 09.12.2015 в 17:43, в сообщении № 2
2) через прибавление к предыдущей строке
If EmptyRows = 2 Then
Cells(EmptyRows, 1) = 1 'если первая запись (т.е строка 2) ставим № 1
Else
Cells(EmptyRows, 1) = Cells(EmptyRows - 1, 1) + 1 'если запись вторая и больше (т.е. строка 3 и больше), то к значению в предыдущей строке прибавляем 1
End If


Вопрос закрыт
 
Ответить
Сообщениеdevilkurs, Спасибо большое! все получилось)

Цитата devilkurs, 09.12.2015 в 17:43, в сообщении № 2
2) через прибавление к предыдущей строке
If EmptyRows = 2 Then
Cells(EmptyRows, 1) = 1 'если первая запись (т.е строка 2) ставим № 1
Else
Cells(EmptyRows, 1) = Cells(EmptyRows - 1, 1) + 1 'если запись вторая и больше (т.е. строка 3 и больше), то к значению в предыдущей строке прибавляем 1
End If


Вопрос закрыт
Автор - AranyHunter
Дата добавления - 09.12.2015 в 18:13
RAN Дата: Среда, 09.12.2015, 21:52 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Написал по этому поводу на Планете
Цитата
Вопрос в том, кто справился?
Вы четвертый? день бомбите два форума одними и теми же вопросами, и НИГДЕ не считаете нужным сообщить об этом.
В одной из ваших тем ответил. Сожалею.

Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеНаписал по этому поводу на Планете
Цитата
Вопрос в том, кто справился?
Вы четвертый? день бомбите два форума одними и теми же вопросами, и НИГДЕ не считаете нужным сообщить об этом.
В одной из ваших тем ответил. Сожалею.
Автор - RAN
Дата добавления - 09.12.2015 в 21:52
devilkurs Дата: Среда, 09.12.2015, 22:24 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 167
Репутация: 43 ±
Замечаний: 0% ±

Excel 2007, 2010
мммммда. AranyHunter некрасиво!

[offtop] RAN, спасибо что обратил внимание, я как-то даже и не думал, что на планете дублируют

 
Ответить
Сообщениемммммда. AranyHunter некрасиво!

[offtop] RAN, спасибо что обратил внимание, я как-то даже и не думал, что на планете дублируют
Автор - devilkurs
Дата добавления - 09.12.2015 в 22:24
AranyHunter Дата: Среда, 09.12.2015, 23:23 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
RAN, я дублирую темы для того что бы быстрее справиться со своей задачей! где мне подсказали там я отвечаю постом со скриптом! а на параллельном форуме отвечаю что вопрос закрыт!
 
Ответить
СообщениеRAN, я дублирую темы для того что бы быстрее справиться со своей задачей! где мне подсказали там я отвечаю постом со скриптом! а на параллельном форуме отвечаю что вопрос закрыт!
Автор - AranyHunter
Дата добавления - 09.12.2015 в 23:23
RAN Дата: Четверг, 10.12.2015, 00:21 | Сообщение № 7
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Цитата AranyHunter, 09.12.2015 в 23:23, в сообщении № 6
дублирую темы для того что бы быстрее справиться со своей задачей

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

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Цитата AranyHunter, 09.12.2015 в 23:23, в сообщении № 6
дублирую темы для того что бы быстрее справиться со своей задачей

А я, например, нигде не отвечаю только потому, что дублируете, и не сообщаете об этом.
Хотя и мог бы.
Автор - RAN
Дата добавления - 10.12.2015 в 00:21
AranyHunter Дата: Суббота, 12.12.2015, 00:52 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Прошу прощения за мою не дальнозоркость! Исправлюсь ! Данная тема дублируется на стороннем сайте ссылка
 
Ответить
СообщениеПрошу прощения за мою не дальнозоркость! Исправлюсь ! Данная тема дублируется на стороннем сайте ссылка
Автор - AranyHunter
Дата добавления - 12.12.2015 в 00:52
QwertyBoss Дата: Воскресенье, 13.12.2015, 18:54 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
AranyHunter ай-ай-ай =)
 
Ответить
СообщениеAranyHunter ай-ай-ай =)
Автор - QwertyBoss
Дата добавления - 13.12.2015 в 18:54
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос нумератор (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!