Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Макрос сортировка по горизонтали
 
Jack Famous, спасибо! Перенес в отдельный модуль, появилась другая ошибка, что окончание макроса некорректное. Хотел уже написать, потом думаю получу опять люлей за вопрос. Посидел, подумал, понял где не так.
МатросНаЗебре, Спасибо за макрос! Я так и думал что не правильно скопировал. Не видел в обучающих видео, что можно несколько макросов в один модуль добавить, думал надо кусками копировать. Всё заработало.
Макрос сортировка по горизонтали
 
МатросНаЗебре, скопировал весь код из сообщения 9.
Макрос сортировка по горизонтали
 
МатросНаЗебре, я, наверно, что-то неправильно понял и вырвал кусок из кода. Можете еще раз прислать код от и до, который надо скопировать, чтобы диапазоны в файле выделялись и сортировались сами?
Макрос сортировка по горизонтали
 
Добрый день! МатросНаЗебре, а в этой строке нет ошибки? Она же сортирует колонки?
Код
Set r = .Range(.Cells(y1, workRange.Column), .Cells(y2, workRange.Column + workRange.Columns.Count - 1))
                 
                SortColumnRange r
Макрос сортировка по горизонтали
 
Добрый день! МатросНаЗебре, сравнил изменения, после применения макроса 10 колонок только сортируются. Остальные на месте остаются. Кроме диапазона A:EL еще надо что-то изменить?
Код
Sub SortColumnAutoSelectRange()
    Const workRangeAddress = "A:EL"
     
    Dim workRange As Range
    On Error Resume Next
    Set workRange = ActiveSheet.Range(workRangeAddress)
    On Error GoTo 0
     
    If workRange Is Nothing Then
        MsgBox "Не понял адрес " & workRangeAddress, vbCritical
        Exit Sub
    End If
     
    Dim arr As Variant
    Dim y1 As Long
    Dim y2 As Long
    Dim r As Range
    With workRange.Parent
        y1 = .Cells(.Rows.Count, workRange.Column).End(xlUp).Row
        arr = .Range(.Cells(1, workRange.Column), .Cells(y1 + 1, workRange.Column))
         
        For y1 = workRange.Row To UBound(arr, 1)
            If Not IsEmpty(arr(y1, 1)) Then
                y2 = y1
                Do
                    If y2 = UBound(arr, 1) Then Exit Do
                    If IsEmpty(arr(y2, 1)) Then
                        y2 = y2 - 1
                        Exit Do
                    Else
                        y2 = y2 + 1
                    End If
                Loop
                 
                Set r = .Range(.Cells(y1, workRange.Column), .Cells(y2, workRange.Column + workRange.Columns.Count - 1))
                 
                SortColumnRange r
                 
                y1 = y2 + 1
            End If
        Next
    End With
End Sub
  
Макрос преобразовывает результат формулы в значение. Как оставить формулу?
 
МатросНаЗебре, Спасибо!
Макрос преобразовывает результат формулы в значение. Как оставить формулу?
 
МатросНаЗебре, Спасибо! А с первой формулой как быть? =СЧЁТЗ(а дальше должен быть диапазон ячеек, причем всё время разный). Не понимаю как его в R1C1 перевести, если это вообще возможно.

Код
.Cells(i + 1, k).FormulaLocal = Application.WorksheetFunction.CountA(Range(.Cells(i, k), .Cells(i - x + 1, k)))
Макрос преобразовывает результат формулы в значение. Как оставить формулу?
 


Добрый день! Прикладываю файл с примером. Есть макрос, он на лист 1 добавляет данные с листа 2, добавляет шапку и 2 формулы. Но формулы при применении макроса превращают ячейки в значения.

Код
Dim i As Long, lr As Long, cell As Range, sh2 As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set sh2 = Worksheets("Лист2")
With Worksheets("Лист1")
For i = lr To 2 Step -1
x = Application.WorksheetFunction.CountIf(.Columns(3), .Cells(i, 3))
.Rows(i + 1 & ":" & i + 3).EntireRow.Insert
.Cells(i + 1, 5) = "Факт": .Cells(i + 2, 5) = "План": .Cells(i + 3, 5) = "Разница"
Set cell = sh2.Columns(1).Find(.Cells(i, 3))
sh2.Range(sh2.Cells(cell.Row + 1, 2), _
sh2.Cells(cell.Row + 1, 143)).Copy Destination:=.Cells(i + 2, 6)
    For k = 6 To 15
        .Cells(i + 1, k).FormulaLocal = Application.WorksheetFunction.CountA(Range(.Cells(i, k), .Cells(i - x + 1, k)))
        .Cells(i + 3, k).FormulaLocal = .Cells(i + 1, k) - .Cells(i + 2, k)
    Next k
If i - x = 1 Then
    .Rows("1:3").EntireRow.Insert
    .Cells(3, 5) = "Город": .Cells(2, 5) = "ЗО": .Cells(1, 5) = "Формат"
    sh2.Range("B2:EM2").Copy Destination:=.Cells(3, 6)
    sh2.Range("B1:EM1").Copy Destination:=.Cells(2, 6)
    sh2.Range(sh2.Cells(cell.Row, 2), sh2.Cells(cell.Row, 15)).Copy Destination:=.Cells(1, 6)
Else
    .Rows(i - x + 1 & ":" & i - x + 5).EntireRow.Insert
    .Rows(1).Copy Destination:=.Rows(i - x + 5)
    .Cells(i - x + 4, 5) = "Город": .Cells(i - x + 3, 5) = "ЗО": .Cells(i - x + 2, 5) = "Формат"
    sh2.Range("B2:EM2").Copy Destination:=.Cells(i - x + 4, 6)
    sh2.Range("B1:EM1").Copy Destination:=.Cells(i - x + 3, 6)
    sh2.Range(sh2.Cells(cell.Row, 2), sh2.Cells(cell.Row, 143)).Copy Destination:=.Cells(i - x + 2, 6)
End If
i = i - x + 1
Next i
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

В ячейке F11 и вправо до упора, хотелось бы видеть живую формулу =СЧЁТЗ, а в F13 =F11-F12. Можно эти формулы заменить на другие, чтобы формулы в ячейках оставались формулами?

Код
    For k = 6 To 15
        .Cells(i + 1, k).FormulaLocal = Application.WorksheetFunction.CountA(Range(.Cells(i, k), .Cells(i - x + 1, k)))
        .Cells(i + 3, k).FormulaLocal = .Cells(i + 1, k) - .Cells(i + 2, k)
    Next k
Макрос сортировка по горизонтали
 
МатросНаЗебре, мой косяк. Всё ок, не заметил, что сверху надо еще кусок макроса вставить. Спасибо за помощь!
Макрос сортировка по горизонтали
 
МатросНаЗебре, Добрый день! При запуске макроса вылезает ошибка. В файле с примером такая же ошибка выходит.
Макрос сортировка по горизонтали
 
МатросНаЗебре, Спасибо! в файле, который я вложил для примера всё работает. Думал будет понятный для меня код и области в которых надо работать смогу исправить сам, но не получилось. В файле с примером, чтобы не писать лишнее, я убрал колонки слева, так как с ними ничего не должно происходить. Если у меня колонка А из файла с примером на самом деле E(колонка 5), а конечная EL(колонка 142), в какие строки надо вписать их номера? Несколько вариантов попробовал, всё равно данные съезжают при применении макроса.
Макрос сортировка по горизонтали
 
МатросНаЗебре, Спасибо! Забыл одно уточнение написать, на картинках просто пытался детально процесс показать. А про то, что макрос области сам должен находить не написал.
А можно тоже самое, но чтобы мне не надо было самому выделять области?
Этот же макрос по выделенной области сортирует? По другому он у меня не работает. Либо я что-то не так делаю.
Изменено: Андрей Неизвестный - 11.03.2021 16:57:10
Макрос сортировка по горизонтали
 
Добрый день!
В первом сообщении вложен файл. Прилагаю к нему скрины. Берем первый блок, выделяем диапазон B1:K21. Применяем к нему сортировку по столбцам. Сортировку от А до Я по стоке 1, по строке 2, по строке 3, потом снова по строке 1 и еще раз по строке 2. Далее идем по файлу ниже. Выделяем диапазон B23:K31. Применяем к нему такую же сортировку по столбцам.
 
Макрос сортировка по горизонтали
 
Добрый день!

Пытаюсь сделать первый макрос. Не выходит. Такое впечатление, что диапазоны напутал. Есть файл с блоками инфо. Кол-во блоков и строк в блоке может быть разное. Необходимо все диапазоны от колонки B до K отфильтровать по шапке. По колонкам от меньшего к большему. Фильтр в такой последовательности: Размер, ЗО, Город, Размер, ЗО.
Может кто-нибудь подсказать как макрос подправить?

Спасибо![
Код
Dim i As Long, lr As Long, cell As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 1 Step -1
For k = 2 To 11
        ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
        ' горизонтальный фильтр для строки 1 от меньшего к большему
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range(Cells(Rows.Count, 1).End(xlToRight).Row), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range(Column.Count, 2).End(xlToRight).Column
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
    ' горизонтальный фильтр для строки 2 от меньшего к большему
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range(Cells(Rows.Count, 2).End(xlToRight).Row), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range(Column.Count, 2).End(xlToRight).Column
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
    ' горизонтальный фильтр для строки 3 от меньшего к большему
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range(Cells(Rows.Count, 3).End(xlToRight).Row), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range(Column.Count, 2).End(xlToRight).Column
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
       ' горизонтальный фильтр для строки 1 от меньшего к большему
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range(Cells(Rows.Count, 1).End(xlToRight).Row), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range(Column.Count, 2).End(xlToRight).Column
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
    ' горизонтальный фильтр для строки 2 от меньшего к большему
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range(Cells(Rows.Count, 2).End(xlToRight).Row), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range(Column.Count, 2).End(xlToRight).Column
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = TrueEnd Sub

Макрос преобразовывает результат формулы в значение. Как оставить формулу?
 
БМВ, не очень понял. NumberFormat в кавычки что писать? Можно прямо в код вписать? Спасибо!
Код
For k = 6 To 135
        .Cells(i + 1, k).FormulaR1C1 = "Application.WorksheetFunction.CountA(Range(.Cells(i, k), .Cells(i - x + 1, k)))"
        .Cells(i + 3, k).FormulaR1C1 = ".Cells(i + 1, k) - .Cells(i + 2, k)"
    Next k
Изменено: Андрей Неизвестный - 04.11.2020 17:50:22
Макрос преобразовывает результат формулы в значение. Как оставить формулу?
 
не сработало. все варианты попробовал, всё равно формулы нет. Попробовал эксперимент. В рандомном файле вставил формулу и включил рекордер. Получилось вот так. Попробовал вариант, который показывал выше заключить в кавычки. В результате в ячейку с формулой получил текст этой формулы.
Код
ActiveCell.FormulaR1C1 = "=COUNTA(R[-10]C:R[-1]C)"
Макрос преобразовывает результат формулы в значение. Как оставить формулу?
 
Куска достаточно?
Код
 For k = 6 To 135
        .Cells(i + 1, k) = Application.WorksheetFunction.CountA(Range(.Cells(i, k), .Cells(i - x + 1, k)))
        .Cells(i + 3, k) = .Cells(i + 1, k) - .Cells(i + 2, k)
    Next k
Изменено: Андрей Неизвестный - 04.11.2020 15:34:04
Макрос преобразовывает результат формулы в значение. Как оставить формулу?
 
Добрый день!

Кто-нибудь знает, что надо добавить в макрос, чтобы формула осталась формулой, а не преобразовывалась в значение автоматом? Перерыл весь интернет, нашел только статьи, где всё наоборот, умышленное преобразование формулы в значение.
Отфильтровать колонки от меньшего значения к большему
 
Добрый день!

Пример во вложении. Есть таблица в которой надо отфильтровать колонки от меньшего значения к большему. Руками когда делаю, то фильтрую сначала по строке формат, потом регион, потом город, потом снова формат и еще раз регион.

При записи макроса получается вот такой код. Это для первого действия - Фильтр по формату. Далее код повторяется 5 раз, меняются строки к которым применяется фильтр.
Код
Range(ActiveCell, ActiveCell.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range("F1:O1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range("F1:O13")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

Как поменять код, чтобы размер фильтруемой таблицы менялся автоматом и сам фильтр применялся ко всем блокам таблицы? В примере 2 блока, их может быть сколько угодно. По колонке Е в каждом блоке от слова Формат до слова Разница необходимо отфильтровать столбцы справа.
Есть какие идеи? Либо, можно это разбить на несколько последовательных простых действий?

Спасибо!
Макрос_горизонтальная фильтрация. Распознать блоки с разными числами и разделил их.
 
Mershik, Добрый день! Я немного не про то говорил. Не заметил в первом ответе, что макрос написан без фильтров. Думал, что он не работает, потому что у меня диапазон таблицы другой, хотел сам подогнать. Как сделать горизонтальную фильтрацию блоков? Пример данных есть в файле в первом письме. Регион должен быть всегда от меньшего к большему, потом формат.
Макрос_горизонтальная фильтрация. Распознать блоки с разными числами и разделил их.
 
Решил проблему. Методом тыка. Теперь шапку для верхнего блока ставит правильно. Теперь фильтр горизонтальный не работает. Придется опять метод тыка включать
Код
If i - x = 1 Then
    .Rows("1:3").EntireRow.Insert
    .Cells(3, 5) = "Ãîðîä": .Cells(2, 5) = "Ðåãèîí": .Cells(1, 5) = "Ôîðìàò"
    sh2.Range("B2:EA2").Copy Destination:=.Cells(3, 6)
    sh2.Range("B1:EA1").Copy Destination:=.Cells(2, 6)
    sh2.Range(sh2.Cells(cell.Row, 2), sh2.Cells(cell.Row, 131)).Copy Destination:=.Cells(1, 6)
Макрос_горизонтальная фильтрация. Распознать блоки с разными числами и разделил их.
 
Mershik, я понял в чём дело. До этого я запускал макрос на других файлах. Попробовал запустить на файле с примером, который высылал. Вижу теперь что не так. Во втором блоке шапку ставит правильно. У первого идет смещение. Шапка первого блока смещена на 1 строку ниже, чем надо. Скорее всего поэтому и в моем другом файле возникает некий конфликт. В первом блоке, видимо, из-за смещения шапки и горизонтальный фильтр не сработал.
Макрос_горизонтальная фильтрация. Распознать блоки с разными числами и разделил их.
 
Изменил кол-во колонок. Вылезает ошибка. Красным выделил. Понять не могу что не так. Это же в третью строку после таблицы поставить формулу строка 1 минус строка 2? А что ему не нравится то...не пойму
Код
For k = 6 To 142
        .Cells(i + 1, k) = Application.WorksheetFunction.CountA(Range(.Cells(i, k), .Cells(i - x + 1, k)))
        .Cells(i + 3, k) = .Cells(i + 2, k) - .Cells(i + 1, k)
Next k
Макрос_горизонтальная фильтрация. Распознать блоки с разными числами и разделил их.
 
Mershik, спасибо! в общем и целом то, что я хотел. Вставил другую таблицу. Шапки макрос расставил правильно, кроме самой первой, её он засунул посередине таблицы с данными. В какой строке можно изменить данные, чтобы макрос считал не 10 столбиков, а, например, 150? И можно ли формулы из строки Факт и Разница сделать чтобы они остались формулами, а не были преобразованы в значение?
Макрос_горизонтальная фильтрация. Распознать блоки с разными числами и разделил их.
 
Добрый день! Прошу подсказать макрос для файла во вложении. На листе 1 и 2 исходные данные. На листе Итог - требуемая таблица. Колонка С на листе 1 может содержать большое кол-во значений. Шаг между числами любой. Главное чтобы макрос распознавал блоки с разными числами и делил их.
Над каждым блоком должна быть стандартная шапка, внизу блока тоже. И главное фильтры. Регион и формат всегда должен быть от меньшего к большему. Кол-во строк и столбцов может быть разное. Если есть идеи как это сделать пусть и несколькими макросами - прошу подсказать. Руками уже замучался делать. Особенно когда под 80 блоков.
Страницы: 1
Наверх