Доброе утро дамы и господа Иногда при объединении (простите) разъединении объединенной ячейки происходит их раздвоение, т.е. текст из одной объединённой ячейки разделяется после клика на "Отменить объединение ячеек" и заполняет обе (или 3,4....) ячейки абсолютно одинаковым текстом. В результате имеем задвоение данных. Случается это крайне редко, но метко. В результате появилась необходимость выделения задвоенных данных, но не всех, а лишь верхней ячейки четвёртого столбца. Выделять цветом не выйдет, т.к. данные переносятся в ч/б программу и нужны "яркие" фигурные знаки. Я остановился на "ВНИМАНИЕ ЗАДВОЕНИЕ!__________________________" Примерно условие в голове крутится но написать не могу. Если D1 = D2, то [D1]="ВНИМАНИЕ ЗАДВОЕНИЕ!__________________________"&D1 иначе ничего не делаем.
т.е. Если ячейки D1 и D2 одинаковы, то в ячейке D1 перед уже содержащимся текстом нужно написать "ВНИМАНИЕ ЗАДВОЕНИЕ!__________________________" остальные ячейки не трогаем, только D1 и D2.
Доброе утро дамы и господа Иногда при объединении (простите) разъединении объединенной ячейки происходит их раздвоение, т.е. текст из одной объединённой ячейки разделяется после клика на "Отменить объединение ячеек" и заполняет обе (или 3,4....) ячейки абсолютно одинаковым текстом. В результате имеем задвоение данных. Случается это крайне редко, но метко. В результате появилась необходимость выделения задвоенных данных, но не всех, а лишь верхней ячейки четвёртого столбца. Выделять цветом не выйдет, т.к. данные переносятся в ч/б программу и нужны "яркие" фигурные знаки. Я остановился на "ВНИМАНИЕ ЗАДВОЕНИЕ!__________________________" Примерно условие в голове крутится но написать не могу. Если D1 = D2, то [D1]="ВНИМАНИЕ ЗАДВОЕНИЕ!__________________________"&D1 иначе ничего не делаем.
т.е. Если ячейки D1 и D2 одинаковы, то в ячейке D1 перед уже содержащимся текстом нужно написать "ВНИМАНИЕ ЗАДВОЕНИЕ!__________________________" остальные ячейки не трогаем, только D1 и D2.Yar4i
Private Sub Worksheet_Change(ByVal Target As Range) If ActiveSheet.Range("D1").Value = ActiveSheet.Range("D2").Value Then ActiveSheet.Range("D1").Value = "ВНИМАНИЕ ЗАДВОЕНИЕ!__________________________" & ActiveSheet.Range("D1").Value End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If ActiveSheet.Range("D1").Value = ActiveSheet.Range("D2").Value Then ActiveSheet.Range("D1").Value = "ВНИМАНИЕ ЗАДВОЕНИЕ!__________________________" & ActiveSheet.Range("D1").Value End Sub
Это случается в тех случаях, когда ячейки объединяются не дебильным стандартным мелко-мягким методом, затирающим информацию во всех ячейках, попавших в MergeArea, кроме первой ячейки, а "правильным" способом, не нарушающим представление структуры прямоугольной таблицы базы внутренней данных данных Excel и не калечащим результаты фильтрации - методом копирования (наложения) формата объединённой ячейки на группу ячеек. [/offtop]
Это случается в тех случаях, когда ячейки объединяются не дебильным стандартным мелко-мягким методом, затирающим информацию во всех ячейках, попавших в MergeArea, кроме первой ячейки, а "правильным" способом, не нарушающим представление структуры прямоугольной таблицы базы внутренней данных данных Excel и не калечащим результаты фильтрации - методом копирования (наложения) формата объединённой ячейки на группу ячеек. [/offtop]Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Четверг, 26.01.2017, 15:22
Ну а если уж всё-таки использовать объединённые ячейки и данные, не затёртые при "правильном" объединении в скрытых ячейках, Вам всё-таки мешают, то лучше, наверное, обрабатывать исходные файлы до разъединения ячеек. Тогда и при разъединении дублей не будет. Вот, например, таким макросом будут сначала разъединены, а потом объединены стандартным методом все ячейки в выделенном диапазоне:
[vba]
Код
Sub ReMergeCells() If TypeName(Selection) <> "Range" Then Exit Sub If Selection.Cells.Count <= 1 Then Exit Sub If Intersect(Selection, ActiveSheet.UsedRange) Is Nothing Then Exit Sub Dim rMerge As Range, rCell As Range, sAddress$ With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then sAddress = rCell.MergeArea.Address: rCell.UnMerge Range(sAddress).Merge End If Next rCell With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub
[/vba]
Ну а если уж всё-таки использовать объединённые ячейки и данные, не затёртые при "правильном" объединении в скрытых ячейках, Вам всё-таки мешают, то лучше, наверное, обрабатывать исходные файлы до разъединения ячеек. Тогда и при разъединении дублей не будет. Вот, например, таким макросом будут сначала разъединены, а потом объединены стандартным методом все ячейки в выделенном диапазоне:
[vba]
Код
Sub ReMergeCells() If TypeName(Selection) <> "Range" Then Exit Sub If Selection.Cells.Count <= 1 Then Exit Sub If Intersect(Selection, ActiveSheet.UsedRange) Is Nothing Then Exit Sub Dim rMerge As Range, rCell As Range, sAddress$ With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With For Each rCell In Intersect(Selection, ActiveSheet.UsedRange) If rCell.MergeCells Then sAddress = rCell.MergeArea.Address: rCell.UnMerge Range(sAddress).Merge End If Next rCell With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub