Здравствуйте уважаемые. Помогите с макросом для сортировки по дате (В4:В433). Если дата одинакова тогда по номеру ТТН (G4:G433). Может у кого есть пример. Спасибо.
Здравствуйте уважаемые. Помогите с макросом для сортировки по дате (В4:В433). Если дата одинакова тогда по номеру ТТН (G4:G433). Может у кого есть пример. Спасибо.Amator
Кардинальное решение есть - избавляться от объединённых ячеек! Объединённые ячейки - ЗЛО!!! Если ещё не поздно, меняйте структуру данных. Можно, конечно, применить и "костыль для увечного" - переформатировать объединённые ячейки так, чтобы можно было нормально фильтровать. Тогда, вполне возможно, можно будет и сортировать. Надо пробовать. Например, переобъединить ячейки методом, описанным в топике Макрос "ReMerge", подпилив его таким образом, чтобы в скрываемых ячейках писалась не формула-ссылка на первую ячейку объединённого диапазона, а значения из неё (как это сделать, посмотрите в топике Макрос "MergePlus") Но даже если и заработает, потом всё равно намучаетесь: стоит кому-нибудь разъединить хитро объединённую ячейку, как объединить её обратно так же как было он без макроса не сможет. Объединённые ячейки - ЗЛО!!!
Кардинальное решение есть - избавляться от объединённых ячеек! Объединённые ячейки - ЗЛО!!! Если ещё не поздно, меняйте структуру данных. Можно, конечно, применить и "костыль для увечного" - переформатировать объединённые ячейки так, чтобы можно было нормально фильтровать. Тогда, вполне возможно, можно будет и сортировать. Надо пробовать. Например, переобъединить ячейки методом, описанным в топике Макрос "ReMerge", подпилив его таким образом, чтобы в скрываемых ячейках писалась не формула-ссылка на первую ячейку объединённого диапазона, а значения из неё (как это сделать, посмотрите в топике Макрос "MergePlus") Но даже если и заработает, потом всё равно намучаетесь: стоит кому-нибудь разъединить хитро объединённую ячейку, как объединить её обратно так же как было он без макроса не сможет. Объединённые ячейки - ЗЛО!!!Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Понедельник, 26.05.2014, 22:42
Скажите ALEX ST .А как сделать таким образом . Создать временный лист . Скопировать в него нужный диапазон .Разъединить ячейки .Отсортировать. Обратно объединить. Скопировать на исходный лист. Временный лист удалить .
Скажите ALEX ST .А как сделать таким образом . Создать временный лист . Скопировать в него нужный диапазон .Разъединить ячейки .Отсортировать. Обратно объединить. Скопировать на исходный лист. Временный лист удалить .Amator
... и совсем даже не зло (просто мороки больше):) например: [vba]
Код
Sub ertert() Dim i&: Application.ScreenUpdating = False With Range("A4:AD433") .UnMerge .Columns(31).Value = .Columns(2).Value .Columns(32).Value = .Columns(7).Value .Columns(31).Resize(, 2).SpecialCells(4).FormulaR1C1 = "=R[-1]C" With .Resize(, .Columns.Count + 2) .Sort Key1:=.Cells(1, 31), Order1:=xlAscending, _ Key2:=.Cells(1, 32), Order2:=xlAscending End With .Columns(31).Resize(, 2).ClearContents For i = 1 To 430 Step 5 .Cells(i, 1).Resize(5).Merge .Cells(i, 2).Resize(5).Merge .Cells(i, 7).Resize(5).Merge Next End With Application.ScreenUpdating = True End Sub
[/vba]
... и совсем даже не зло (просто мороки больше):) например: [vba]
Код
Sub ertert() Dim i&: Application.ScreenUpdating = False With Range("A4:AD433") .UnMerge .Columns(31).Value = .Columns(2).Value .Columns(32).Value = .Columns(7).Value .Columns(31).Resize(, 2).SpecialCells(4).FormulaR1C1 = "=R[-1]C" With .Resize(, .Columns.Count + 2) .Sort Key1:=.Cells(1, 31), Order1:=xlAscending, _ Key2:=.Cells(1, 32), Order2:=xlAscending End With .Columns(31).Resize(, 2).ClearContents For i = 1 To 430 Step 5 .Cells(i, 1).Resize(5).Merge .Cells(i, 2).Resize(5).Merge .Cells(i, 7).Resize(5).Merge Next End With Application.ScreenUpdating = True End Sub
Создать временный лист . Скопировать в него нужный диапазон .Разъединить ячейки .Отсортировать.
После разъединения ячеек данные останутся только в первой. В остальных - пусто. И как они (пустые ячейки) будут сортироваться? Именно для того, чтобы в скрытых под объединением ячейках были прописаны данные (что обычный Excel не может и честно об этом предупреждает перед объединением не пустых ячеек) и предназначены макросы, на которые я давал ссылки.
4 nilem, Николай, твой код видел, но не разбирал. Был бешеный день. Только сейчас залез в и-нет. Башка не варит абсолютно. Извини.
Создать временный лист . Скопировать в него нужный диапазон .Разъединить ячейки .Отсортировать.
После разъединения ячеек данные останутся только в первой. В остальных - пусто. И как они (пустые ячейки) будут сортироваться? Именно для того, чтобы в скрытых под объединением ячейках были прописаны данные (что обычный Excel не может и честно об этом предупреждает перед объединением не пустых ячеек) и предназначены макросы, на которые я давал ссылки.
4 nilem, Николай, твой код видел, но не разбирал. Был бешеный день. Только сейчас залез в и-нет. Башка не варит абсолютно. Извини.Alex_ST
Нет, Андрей! Ты же профессионал и должен сам понять, из какого из указанных по твоей ссылке топиков и из какого из их постов Amator взял код, который у него не работает, и куда его вставил
Нет, Андрей! Ты же профессионал и должен сам понять, из какого из указанных по твоей ссылке топиков и из какого из их постов Amator взял код, который у него не работает, и куда его вставил Alex_ST
Sub ertert() Dim i&, r As Range: Application.ScreenUpdating = False With Range("A4:AD433") .UnMerge .Columns(31).Value = .Columns(2).Value .Columns(32).Value = .Columns(7).Value For Each r In .Columns(2).SpecialCells(2) r(2, 30).Resize(4, 2).FormulaR1C1 = "=R[-1]C" Next r With .Resize(, .Columns.Count + 2) .Sort Key1:=.Cells(1, 31), Order1:=xlAscending, _ Key2:=.Cells(1, 32), Order2:=xlAscending End With .Columns(31).Resize(, 2).ClearContents For i = 1 To 430 Step 5 .Cells(i, 1).Resize(5).Merge .Cells(i, 2).Resize(5).Merge .Cells(i, 7).Resize(5).Merge Next End With Application.ScreenUpdating = True End Sub
[/vba]
кажется, увидел попробуйте так: [vba]
Код
Sub ertert() Dim i&, r As Range: Application.ScreenUpdating = False With Range("A4:AD433") .UnMerge .Columns(31).Value = .Columns(2).Value .Columns(32).Value = .Columns(7).Value For Each r In .Columns(2).SpecialCells(2) r(2, 30).Resize(4, 2).FormulaR1C1 = "=R[-1]C" Next r With .Resize(, .Columns.Count + 2) .Sort Key1:=.Cells(1, 31), Order1:=xlAscending, _ Key2:=.Cells(1, 32), Order2:=xlAscending End With .Columns(31).Resize(, 2).ClearContents For i = 1 To 430 Step 5 .Cells(i, 1).Resize(5).Merge .Cells(i, 2).Resize(5).Merge .Cells(i, 7).Resize(5).Merge Next End With Application.ScreenUpdating = True End Sub
nilem, спасибо , код работает как надо .Нужна одна поправка : столбец "А" не трогать , потому что изменяется нумерация .Или чтоб код после сортировки сделал новую нумерацию в столбце "А".
nilem, спасибо , код работает как надо .Нужна одна поправка : столбец "А" не трогать , потому что изменяется нумерация .Или чтоб код после сортировки сделал новую нумерацию в столбце "А".Amator
Sub ertert() Dim i&, r As Range: Application.ScreenUpdating = False With Range("B4:AD433") .UnMerge .Columns(30).Value = .Columns(1).Value .Columns(31).Value = .Columns(6).Value For Each r In .Columns(1).SpecialCells(2) r(2, 30).Resize(4, 2).FormulaR1C1 = "=R[-1]C" Next r With .Resize(, .Columns.Count + 2) .Sort Key1:=.Cells(1, 30), Order1:=xlAscending, _ Key2:=.Cells(1, 31), Order2:=xlAscending End With .Columns(30).Resize(, 2).ClearContents For i = 1 To 430 Step 5 .Cells(i, 1).Resize(5).Merge .Cells(i, 6).Resize(5).Merge Next End With Application.ScreenUpdating = True End Sub
[/vba]
можно попробовать изменить индексы: [vba]
Код
Sub ertert() Dim i&, r As Range: Application.ScreenUpdating = False With Range("B4:AD433") .UnMerge .Columns(30).Value = .Columns(1).Value .Columns(31).Value = .Columns(6).Value For Each r In .Columns(1).SpecialCells(2) r(2, 30).Resize(4, 2).FormulaR1C1 = "=R[-1]C" Next r With .Resize(, .Columns.Count + 2) .Sort Key1:=.Cells(1, 30), Order1:=xlAscending, _ Key2:=.Cells(1, 31), Order2:=xlAscending End With .Columns(30).Resize(, 2).ClearContents For i = 1 To 430 Step 5 .Cells(i, 1).Resize(5).Merge .Cells(i, 6).Resize(5).Merge Next End With Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
