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

Вход

Регистрация

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

 

= Мир MS Excel/макрос Нумерация списка - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » макрос Нумерация списка
макрос Нумерация списка
wild_pig Дата: Воскресенье, 30.12.2012, 23:18 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 518
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
Подскажите (а лучше покажите) как сделать макрос автоматической нумерации списка. Каждая позиция состоит из 3-х строк, номера надо в первых. Список динамический и не на активном листе. Новый год на носу, а нумеровать надо smile
К сообщению приложен файл: _Microsoft_Exce.xls (19.5 Kb)
 
Ответить
СообщениеПодскажите (а лучше покажите) как сделать макрос автоматической нумерации списка. Каждая позиция состоит из 3-х строк, номера надо в первых. Список динамический и не на активном листе. Новый год на носу, а нумеровать надо smile
Автор - wild_pig
Дата добавления - 30.12.2012 в 23:18
AlexM Дата: Воскресенье, 30.12.2012, 23:36 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4517
Репутация: 1129 ±
Замечаний: 0% ±

Excel 2003
А формулой не подойдет?
В ячейку В7 вставить формулу
Код
=ЕСЛИ(ОСТАТ(СТРОКА(A1)-1;3);"";ОКРВВЕРХ(СТРОКА(A1)/3;1))

И протянуть ее вниз


Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
СообщениеА формулой не подойдет?
В ячейку В7 вставить формулу
Код
=ЕСЛИ(ОСТАТ(СТРОКА(A1)-1;3);"";ОКРВВЕРХ(СТРОКА(A1)/3;1))

И протянуть ее вниз
Автор - AlexM
Дата добавления - 30.12.2012 в 23:36
Serge_007 Дата: Воскресенье, 30.12.2012, 23:49 | Сообщение № 3
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
Вариант:
Код
=ЕСЛИ(ОСТАТ(СТРОКА()-7;3);"";МАКС(A$6:A6)+1)

ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
СообщениеВариант:
Код
=ЕСЛИ(ОСТАТ(СТРОКА()-7;3);"";МАКС(A$6:A6)+1)
Автор - Serge_007
Дата добавления - 30.12.2012 в 23:49
wild_pig Дата: Воскресенье, 30.12.2012, 23:50 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 518
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
Тягать за крестик я давно умею ) хотелось при добавлении новой позиции ну или когда потребуется нумерация проходила без вмешательства шаловливых ручек.
есть у меня такой макрос
[vba]
Код
Sub num()
With Sheets("Лист1")
x = .[C7].CurrentRegion.Rows.Count
.Range("B7") = 1
If x > 2 Then
.Range("B8") = 2
.Range("B7:B8").AutoFill Destination:=.Range("B7:B" & x), Type:=xlFillDefault
End If
End With
End Sub
[/vba]
но он выдаёт ошибки при пустых ячейках над нумерацией и когда позиций меньше 3х.


Сообщение отредактировал wild_pig - Воскресенье, 30.12.2012, 23:53
 
Ответить
СообщениеТягать за крестик я давно умею ) хотелось при добавлении новой позиции ну или когда потребуется нумерация проходила без вмешательства шаловливых ручек.
есть у меня такой макрос
[vba]
Код
Sub num()
With Sheets("Лист1")
x = .[C7].CurrentRegion.Rows.Count
.Range("B7") = 1
If x > 2 Then
.Range("B8") = 2
.Range("B7:B8").AutoFill Destination:=.Range("B7:B" & x), Type:=xlFillDefault
End If
End With
End Sub
[/vba]
но он выдаёт ошибки при пустых ячейках над нумерацией и когда позиций меньше 3х.
Автор - wild_pig
Дата добавления - 30.12.2012 в 23:50
Serge_007 Дата: Понедельник, 31.12.2012, 00:20 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
Цитата (wild_pig)
Тягать за крестик я давно умею

Можно и не тягать:
[vba]
Код
Sub wild_pig()
    Sheets("Девки").Range("B7:B21").FormulaR1C1 = _
         "=IF(MOD(ROW(R[-6]C[-1])-1,3),"""",CEILING(ROW(R[-6]C[-1])/3,1))"
End Sub
[/vba]

ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
Цитата (wild_pig)
Тягать за крестик я давно умею

Можно и не тягать:
[vba]
Код
Sub wild_pig()
    Sheets("Девки").Range("B7:B21").FormulaR1C1 = _
         "=IF(MOD(ROW(R[-6]C[-1])-1,3),"""",CEILING(ROW(R[-6]C[-1])/3,1))"
End Sub
[/vba]
Автор - Serge_007
Дата добавления - 31.12.2012 в 00:20
wild_pig Дата: Понедельник, 31.12.2012, 00:45 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 518
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
Так ведь конец диапазона неизвестен.
 
Ответить
СообщениеТак ведь конец диапазона неизвестен.
Автор - wild_pig
Дата добавления - 31.12.2012 в 00:45
Serge_007 Дата: Понедельник, 31.12.2012, 00:59 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
Ничто не мешает его определить
Range("B" & Rows.Count).End(xlUp)
Посмотрите похожую тему

ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
СообщениеНичто не мешает его определить
Range("B" & Rows.Count).End(xlUp)
Посмотрите похожую тему
Автор - Serge_007
Дата добавления - 31.12.2012 в 00:59
AlexM Дата: Понедельник, 31.12.2012, 01:52 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4517
Репутация: 1129 ±
Замечаний: 0% ±

Excel 2003
[vba]
Код
Sub FormatRange()
Set MyRange = Sheets("Девки").UsedRange
For i = 1 To MyRange.Rows.Count
     If ((i + 2) Mod 3) = 0 Then Range("B" & MyRange.Item(1).Row + i - 1) = ((i - 1) \ 3) + 1
Next i
End Sub
[/vba]
К сообщению приложен файл: _Microsoft_Exce.xls (35.0 Kb)


Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.
 
Ответить
Сообщение[vba]
Код
Sub FormatRange()
Set MyRange = Sheets("Девки").UsedRange
For i = 1 To MyRange.Rows.Count
     If ((i + 2) Mod 3) = 0 Then Range("B" & MyRange.Item(1).Row + i - 1) = ((i - 1) \ 3) + 1
Next i
End Sub
[/vba]
Автор - AlexM
Дата добавления - 31.12.2012 в 01:52
Gustav Дата: Понедельник, 31.12.2012, 12:23 | Сообщение № 9
Группа: Админы
Ранг: Участник клуба
Сообщений: 2821
Репутация: 1190 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
А если тянуть (копировать) не одну, а сразу три ячейки, то формула до неприличия упрощается:

[vba]
Код
Sub copyNot1But3cells()
     With Sheets("Девки")
         .Range("B7").FormulaR1C1 = "=R[-3]C+1"
         .Range("B7:B9").Copy .Range("B7:B" & _
             .UsedRange.SpecialCells(xlCellTypeLastCell).Row)
     End With
End Sub
[/vba]

МОИ: Ник, Tip box: 41001663842605
 
Ответить
СообщениеА если тянуть (копировать) не одну, а сразу три ячейки, то формула до неприличия упрощается:

[vba]
Код
Sub copyNot1But3cells()
     With Sheets("Девки")
         .Range("B7").FormulaR1C1 = "=R[-3]C+1"
         .Range("B7:B9").Copy .Range("B7:B" & _
             .UsedRange.SpecialCells(xlCellTypeLastCell).Row)
     End With
End Sub
[/vba]
Автор - Gustav
Дата добавления - 31.12.2012 в 12:23
wild_pig Дата: Понедельник, 31.12.2012, 13:14 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 518
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
Цитата (Gustav)
А если тянуть (копировать) не одну, а сразу три ячейки, то формула до неприличия упрощается:


Такой способ не допускает незаполненных ячеек в нумеруемых блоках (по 3), если заполнены не все три, то нумерация не происходит. У Алекса код "шо нада" почти )
Спасибо, вам, всем. Уже 12 часов, а не в одном глазу(
С наступающим, вас, Новым годом. Желаю успехов и здоровья. Ещё раз СПАСИБО!


Сообщение отредактировал wild_pig - Понедельник, 31.12.2012, 14:55
 
Ответить
Сообщение
Цитата (Gustav)
А если тянуть (копировать) не одну, а сразу три ячейки, то формула до неприличия упрощается:


Такой способ не допускает незаполненных ячеек в нумеруемых блоках (по 3), если заполнены не все три, то нумерация не происходит. У Алекса код "шо нада" почти )
Спасибо, вам, всем. Уже 12 часов, а не в одном глазу(
С наступающим, вас, Новым годом. Желаю успехов и здоровья. Ещё раз СПАСИБО!
Автор - wild_pig
Дата добавления - 31.12.2012 в 13:14
Gustav Дата: Понедельник, 31.12.2012, 16:02 | Сообщение № 11
Группа: Админы
Ранг: Участник клуба
Сообщений: 2821
Репутация: 1190 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
Цитата (wild_pig)
Такой способ не допускает незаполненных ячеек в нумеруемых блоках (по 3), если заполнены не все три, то нумерация не происходит.

В смысле? Вы думаете, я предложил бы решение, не убедившись в его работоспособности?

МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
Цитата (wild_pig)
Такой способ не допускает незаполненных ячеек в нумеруемых блоках (по 3), если заполнены не все три, то нумерация не происходит.

В смысле? Вы думаете, я предложил бы решение, не убедившись в его работоспособности?
Автор - Gustav
Дата добавления - 31.12.2012 в 16:02
kalbasiatka Дата: Понедельник, 31.12.2012, 17:51 | Сообщение № 12
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Gustav, если заполнить три первых ячейки будет номер 1, если заполнить четыре ячейки будет тоже 1, только когда будет шесть записей появится 2. Так тоже хорошо ну, а если забудем внести данные , а цифру очень хочется:-)
 
Ответить
СообщениеGustav, если заполнить три первых ячейки будет номер 1, если заполнить четыре ячейки будет тоже 1, только когда будет шесть записей появится 2. Так тоже хорошо ну, а если забудем внести данные , а цифру очень хочется:-)
Автор - kalbasiatka
Дата добавления - 31.12.2012 в 17:51
AlexM Дата: Вторник, 01.01.2013, 10:53 | Сообщение № 13
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4517
Репутация: 1129 ±
Замечаний: 0% ±

Excel 2003
Еще вариант. Может быть пригодится. Макрос срабатывает по событию на листе - изменение значения в ячейке.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
RowStart = 7 'начало таблицы
If Not Intersect(Range("C" & RowStart & ":C65536"), Target) Is Nothing Then
On Error GoTo Errors1
If Target.Address(0, 0) = "C" & RowStart Then Target.Offset(0, -1) = 1: GoTo Errors1
Target.Offset(0, -1) = IIf(Target.Offset(-3, -1) <> Empty And Target <> "", Target.Offset(-3, -1) + 1, "")
If Target.Offset(-3, -1) = Empty And Target.Offset(-1, 0) = "" Then Target = ""
End If
Errors1:
Application.EnableEvents = True
End Sub
[/vba]
В код добавлена строка. Без нее нельзя заполнить таблицу с "нуля"
[vba]
Код
If Target.Address(0, 0) = "C" & RowStart Then Target.Offset(0, -1) = 1: GoTo Errors1
[/vba]
К сообщению приложен файл: _MS_Exce_new5.xls (34.0 Kb)


Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Сообщение отредактировал AlexM - Вторник, 01.01.2013, 23:37
 
Ответить
СообщениеЕще вариант. Может быть пригодится. Макрос срабатывает по событию на листе - изменение значения в ячейке.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
RowStart = 7 'начало таблицы
If Not Intersect(Range("C" & RowStart & ":C65536"), Target) Is Nothing Then
On Error GoTo Errors1
If Target.Address(0, 0) = "C" & RowStart Then Target.Offset(0, -1) = 1: GoTo Errors1
Target.Offset(0, -1) = IIf(Target.Offset(-3, -1) <> Empty And Target <> "", Target.Offset(-3, -1) + 1, "")
If Target.Offset(-3, -1) = Empty And Target.Offset(-1, 0) = "" Then Target = ""
End If
Errors1:
Application.EnableEvents = True
End Sub
[/vba]
В код добавлена строка. Без нее нельзя заполнить таблицу с "нуля"
[vba]
Код
If Target.Address(0, 0) = "C" & RowStart Then Target.Offset(0, -1) = 1: GoTo Errors1
[/vba]
Автор - AlexM
Дата добавления - 01.01.2013 в 10:53
wild_pig Дата: Вторник, 01.01.2013, 11:38 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 518
Репутация: 97 ±
Замечаний: 0% ±

2003, 2013
Спасибо.
 
Ответить
СообщениеСпасибо.
Автор - wild_pig
Дата добавления - 01.01.2013 в 11:38
NATA1111 Дата: Среда, 17.09.2014, 10:57 | Сообщение № 15
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте, подскажите, а если надо нумеровать только строки содержащие пол: ж.
[moder]Тогда нужно прочитать Правила форума и создать свою тему
 
Ответить
СообщениеЗдравствуйте, подскажите, а если надо нумеровать только строки содержащие пол: ж.
[moder]Тогда нужно прочитать Правила форума и создать свою тему
Автор - NATA1111
Дата добавления - 17.09.2014 в 10:57
NATA1111 Дата: Среда, 17.09.2014, 11:09 | Сообщение № 16
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Создала, извините
 
Ответить
СообщениеСоздала, извините
Автор - NATA1111
Дата добавления - 17.09.2014 в 11:09
Мир MS Excel » Вопросы и решения » Вопросы по Excel » макрос Нумерация списка
  • Страница 1 из 1
  • 1
Поиск:

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