Прошу помочь с простеньким кодом

[bank_notes]

Здравствуйте! Вот подумал, может и мне кто поможет…

[The_Prist]

С объединенными ячейками - никак...

[Aent]

Сообщение от The_Prist

с объединёнными ячейками - никак...

Согласен. Видимо имеет смысл предварительно "разъединить" ячейки,
добавить новые строки в конец таблицы, отсортировать, и, наконец,
вновь объединить ячейки в соответствии с требованиями клиента

[bank_notes]

А ежели исключить ячейки, объединенные по вертикали., можно ли решить задачу при помощи кода?

[Aent]

Ну да. Копируете новые строки в конец таблицы и сортируете по коду.
Если я правильно понял, что в вашем файле код с первого листа на втором
называется каталог...

[bank_notes]

Да, совершенно верно. А програмно это возможность сделать? Дело в том, что основная таблица состоит из нескольких разделов. И простое копирование – сортировка не подходит, все равно приходится разносить позиции вручную, с помощью самодельного кода (прилагается, прошу громко не смеятья, знаю, что горбатый)…..

[Aent]

bank_notes, дайте полную структуру исходной и принимающей таблиц и будет вам код. Без этого обсуждение бессмысленно.

[analyst]

Сообщение от bank_notes

Да, совершенно верно. А програмно это возможность сделать? Дело в том, что основная таблица состоит из нескольких разделов. И простое копирование – сортировка не подходит, все равно приходится разносить позиции вручную, с помощью самодельного кода (прилагается, прошу громко не смеятья, знаю, что горбатый)…..

Что-то я совсем не пойму что вы хотели этим макросом сделать
Он же даже не рабочий!

[bank_notes]

Вот "собрал" действующий код, который мог бы стать основой для усовершенствования.

Sub СОРТ7()
With Application
.Calculation = xlManual
.ScreenUpdating = False
i = 1
Do Until Sheets("1").Cells(i, 2) = ""
d = Workbooks("2.xls").Worksheets("1"). Cells(i, 3).Value
Set iCell = Workbooks("2.xls").Worksheets("2"). Columns("B").Find _
(What:=d, LookIn:=xlValues, LookAt:=xlPart)
r = iCell.Offset(0, -1).Value
c = Workbooks("2.xls").Worksheets("1"). Cells(i, 2).Value
If Not iCell Is Nothing Then
iAddress = iCell.Address
Do
If c < r Then
iCell.EntireRow.Insert
Worksheets(1).Activate
Worksheets(1).Range(Cells(i, 2), Cells(i, 10)).Copy Destination:=iCell.Offset(-1, -1).Resize(1, 8)
Exit Do
End If
Set iCell = Workbooks("2.xls").Worksheets("2"). Columns("B").FindNext(after:=iCell)
r = iCell.Cells.Offset(0, -1).Value
Loop While Not iCell Is Nothing And iCell.Address <> iAddress
End If
i = i + 1
Loop
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub

У меня работает, но вот беда и этот код, да и встроенная сортировка упорядочивает значения по столбцу код/каталог таким, например образом:
16
17
11s
14a
14b
15a
18a
9s

А нужно чтобы, чтобы он выстраивал значения в порядке возрастания цифр:

9s
11s
14a
14b
15a
16
17
18a

Можно ли, если да - как это сделать?

[Pelengas]

Чтобы не плодить новых тем, продолжу здесь.
Прошу помочь с простеньким кодом
Есть таблица результатов соревнований по ловле рыбы.
Столбец "Сектор" - порядковый номер сектора от 1 до произвольного значения, но не больше 100.
Столбец "Вес" - вес улова в граммах. Количество секторов с одинаковым весом - произвольное.
Столбец "Место" - в зависимости от веса пойманной рыбы места распределяются от 1 до количества секторов.
Столбец "Место итоговое": При равенстве веса уловов, секторам, имеющим одинаковые результаты, засчитывается количество очков (мест) равное среднему арифметическому от суммы мест, которые они должны были бы поделить.
Задача: для всех секторов, имеющих равные веса, рассчитать итоговое место.
Спасибо.