Страницы: 1
RSS
Макрос объединения ячеек по условиям
 
Планетяне, добрый день!
Т.к. не получается сделать в разделе "Работа" - здесь, я пытаюсь что-то сообразить самостоятельно)))

У меня есть таблица с одной командой и 4 совещаниями (это максимальное количество совещаний, у которых могут совпадать периоды) и уникальными номерами совещаний. Для красоты мне необходимо объединить ячейки, по уникальным номерам.
Изменено: evgeniygeo - 28.06.2022 13:41:38
 
Может Вам изменить подход. Посмотрите ТУТ и ТУТ
 
Msi2102,
с диаграммой Ганта хорошо знаком, но, к сожалению, не могу менять данный формат...
Изменено: evgeniygeo - 28.06.2022 13:54:30
 
Попробуйте так:
Код
Sub Макрос1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim r As Long, c As Long, arr As Variant, n As Variant
arr = Range("A4:D11")
Set Dict = CreateObject("Scripting.Dictionary")
    For c = 1 To UBound(arr, 2)
        For r = 1 To UBound(arr)
            If Not Dict.Exists(arr(r, c)) Then
                Dict.Add arr(r, c), Cells(r + 3, c).Address
            Else
                Dict.Item(arr(r, c)) = Union(Range(Dict.Item(arr(r, c))), Cells(r + 3, c)).Address
            End If
        Next r
    Next c
For Each n In Dict
    If Not n = "" Then Range(Dict.Item(n)).Merge
Next n
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Изменено: Msi2102 - 28.06.2022 15:21:05
 
Msi2102,
ух, это даже работает)))
осталось только понять, как удалить не нужные части.
 
Цитата
evgeniygeo написал:
как удалить не нужные части
, а что там ненужное?
 
Msi2102,
те данные, которые были выделены красным
по сути, в итоге не должно остаться одинаковых номеров
Изменено: evgeniygeo - 29.06.2022 11:20:10
 
А какой критерий выделения? Например, см. рисунок, красный цвет должен объединяться или нет?
Изменено: Msi2102 - 29.06.2022 11:29:59
 
Msi2102,
получается, что все значения, идущие вниз должны иметь пару правее или левее, если хоть у одной нет, то не объеденяем
красный цвет должен быть очищен, по объединению не важно
Изменено: evgeniygeo - 29.06.2022 11:34:56
 
А как быть в этом случае?
 
Цитата
Msi2102: как быть
и почему именно так, важнее всего  :D
Закономерности не вижу
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Jack Famous написал:
Закономерности не вижу
Вот и я тоже, хотел просто оставить диапазоны с наибольшем количеством строк, но тоже не всё гладко.
Самое простое это не ставить идентификаторы в те ячейки которые не нужно объединять  :D
Или вот вариант, какой из них правильный?
Изменено: Msi2102 - 29.06.2022 12:00:34
 
Msi2102,
данных случаев просто не может быть)))

но согласен, тупость, поэтому приложил файл-пример построения этих данных для большего понимания))
Изменено: evgeniygeo - 29.06.2022 12:16:58
 
Цитата
evgeniygeo написал:
просто не может быть
Это почему? По рисунку в сообщении №12, Первое и второе совещание начинаются одновременно, но второе совещание очень длинное и в конце пересекается с третьем совещанием.
Мое мнение я высказал в сообщении №2
Цитата
Msi2102 написал:
Посмотрите  ТУТ  и  ТУТ
И выглядело бы это примерно так, а уж этот график можно переформатировать в любой другой
 
Msi2102,
я изначально пытаюсь сходящиеся по времени совещания разнести в разные колонки и далее, в случае отсутствия совпадающих по времени совещаний, распределить найденные совещания  :)
Jack Famous,
надеюсь, что Вы тоже увидите закономерность)))
Изменено: evgeniygeo - 29.06.2022 12:28:36
 
evgeniygeo, Вот вариант по максимальному количеству строк в диапазоне.
Для наглядности вставил MsgBox который показывает собранные диапазоны, после того как Вам станет ясно, что и как удалите чтобы не мешал.
Далее их разбивает анализируем и с наибольшим количеством строк объединяем, остальные красим в красный. Если будут два диапазона с одинаковым количеством, по объединит оба. Для понимания как записаны диапазоны я их разграничил. Попробуйте на двух вариантах, чтобы понять разницу.
Если нужно другой принцип выбора диапазона, переделаете как нужно Вам, то пример анализа Вам показал в этом коде,
Код
Sub Макрос1()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim r As Long, c As Long, arr As Variant, n As Variant, mx As Variant
arr = Range("A4:D11")
Set Dict = CreateObject("Scripting.Dictionary")
    For c = 1 To UBound(arr, 2)
        For r = 1 To UBound(arr)
            If Not Dict.Exists(arr(r, c)) Then
                Dict.Add arr(r, c), Cells(r + 3, c).Address
            Else
                Dict.Item(arr(r, c)) = Union(Range(Dict.Item(arr(r, c))), Cells(r + 3, c)).Address
            End If
        Next r
    Next c
For Each n In Dict
'Для наглядности вставил MsgBox который показывает собранные диапазоны.
'Далее их разбивает анализируем и с наибольшим количеством строк объединяем, остальные красим в красный
    MsgBox Dict.Item(n)
    If Not n = "" Then
        mx = 0
        arr1 = Split(Dict.Item(n), ",")
        For Each m In arr1
            If mx < Range(m).Rows.Count Then mx = Range(m).Rows.Count
        Next m
        For Each m In arr1
            If Range(m).Rows.Count = mx Then Range(m).Merge Else Range(m).Interior.Color = vbRed
        Next m
    End If
Next n
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
Msi2102,
спасибо Вам большое, буду мучать)))
Страницы: 1
Наверх