Пустые ячейки выделяются дублями при условном форматировании

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Пустые ячейки выделяются дублями при условном форматировании (Макросы/Sub)

Alex2354

Дата: Суббота, 22.04.2023, 22:01 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 0 ±

Замечаний: 0% ±

Доброго времени суток.

Есть табличка I26:J35. При копировании макросом в С26:С35 и E25:E35 на пустых ячейках срабатывает условное форматирование на повторяющихся значениях.
Что можно поправить в макросе, чтобы это исправить?

[vba]

Код

Sub Copy()

    Range("I26:I35").Copy 'Диапазон копирование
    Range("C26").Select 'Место вставки данных
    Selection.PasteSpecial (xlPasteValues)
    Range("J26:J35").Copy 'Диапазон копирование
    Range("E26").Select 'Место вставки данных
    Selection.PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False

End Sub

[/vba]

Или полный вариант задачи: G4:G23 повторяющиеся значения, которые надо разбить без дублей (сохранив порядок) на два столбца в таблицу C26:F35 с нумерацией от 1 и дальше... Нумерация в столбцах C и E нужна в виде значений, а не формул. А значения в D и F подставляем формулой.

H4:H23 считаются повторы.

В C36

Код

(СЧЁТЕСЛИ(H4:H23;1)+1)/2

и E36

Код

СЧЁТЕСЛИ(H4:H23;1)

считаем до какого числа нумерация в столбце.

В I25:J35 вспомогательная табличка с номерами, которую копирую в столбцы C25... и E25...

Как избавиться от выделения дублями пустых ячеек, не отключая условного форматирования..
Спасибо.

К сообщению приложен файл: kniga2.xlsm (23.2 Kb)

Ответить

Gustav

Дата: Воскресенье, 23.04.2023, 00:48 | Сообщение № 2

Группа: Админы

Ранг: Участник клуба

Сообщений: 2797

Репутация: 1161 ±

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Цитата Alex2354, 22.04.2023 в 22:01, в сообщении № 1 (

)

Что можно поправить в макросе, чтобы это исправить?

Минимально как-то так:
[vba]

Код

Sub Copy()

    Dim cell As Range '--- добавлено ---
    Range("I26:I35").Copy 'Диапазон копирование
    Range("C26").Select 'Место вставки данных
    Selection.PasteSpecial xlPasteValues
    For Each cell In Selection.Cells
        If cell = "" Then cell.ClearContents '--- добавлено ---
    Next cell
    Range("J26:J35").Copy 'Диапазон копирование
    Range("E26").Select 'Место вставки данных
    Selection.PasteSpecial xlPasteValues
    For Each cell In Selection.Cells
        If cell = "" Then cell.ClearContents '--- добавлено ---
    Next cell
    Application.CutCopyMode = False

End Sub

[/vba]