Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/НЕвыделение ячейки без дубликата по событию - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » НЕвыделение ячейки без дубликата по событию (Макросы/Sub)
НЕвыделение ячейки без дубликата по событию
ant6729 Дата: Вторник, 16.05.2017, 21:16 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 304
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Добрый день! Подскажите, пожалуйста, как дописать, чтобы при отсутствии дубликатов в колонке происходил ExitSub моего условия.
Если это возможно, конечно.
Код в модуле листа примера.
К сообщению приложен файл: 2505792.xlsm(13Kb)


Сообщение отредактировал ant6729 - Вторник, 16.05.2017, 21:17
 
Ответить
СообщениеДобрый день! Подскажите, пожалуйста, как дописать, чтобы при отсутствии дубликатов в колонке происходил ExitSub моего условия.
Если это возможно, конечно.
Код в модуле листа примера.

Автор - ant6729
Дата добавления - 16.05.2017 в 21:16
KuklP Дата: Вторник, 16.05.2017, 21:38 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2214
Репутация: 472 ±
Замечаний: 0% ±

2003-2010
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i&
    lr = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
    If Target.Count > 1 Then Exit Sub
    For i = 1 To lr
        If Me.Cells(i, 1).Address <> Target.Address Then
            If Me.Cells(i, 1).Value = Target.Value Then
                Sheets("Лист2").Cells(i, 2).Interior.Color = RGB(255, 128, 128)
                MsgBox Sheets("Лист2").Cells(i, 1).Address
            End If
        End If
    Next i
End Sub
[/vba]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i&
    lr = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
    If Target.Count > 1 Then Exit Sub
    For i = 1 To lr
        If Me.Cells(i, 1).Address <> Target.Address Then
            If Me.Cells(i, 1).Value = Target.Value Then
                Sheets("Лист2").Cells(i, 2).Interior.Color = RGB(255, 128, 128)
                MsgBox Sheets("Лист2").Cells(i, 1).Address
            End If
        End If
    Next i
End Sub
[/vba]

Автор - KuklP
Дата добавления - 16.05.2017 в 21:38
ant6729 Дата: Вторник, 16.05.2017, 21:55 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 304
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Спасибо, KuklP!
Я зачем -то Else и End If добавлял... не получалось
Ваше решение решает эту "искусственную" проблему, спасибо!!!

А Me. - это что, интересно... Нигде не видел...

А можно ли, например, чтобы последнюю ячейку с дубликатом тоже заливало, если она дублируется? (им ввиду ячейку рядом)


Сообщение отредактировал ant6729 - Вторник, 16.05.2017, 22:04
 
Ответить
СообщениеСпасибо, KuklP!
Я зачем -то Else и End If добавлял... не получалось
Ваше решение решает эту "искусственную" проблему, спасибо!!!

А Me. - это что, интересно... Нигде не видел...

А можно ли, например, чтобы последнюю ячейку с дубликатом тоже заливало, если она дублируется? (им ввиду ячейку рядом)

Автор - ant6729
Дата добавления - 16.05.2017 в 21:55
ant6729 Дата: Вторник, 16.05.2017, 22:00 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 304
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
второй ответ не надо, спасибо, решил
[vba]
Код

Sheets("Лист2").Cells(i, 2).Interior.Color = RGB(255, 128, 128)
                Selection.Offset(0, 1).Interior.Color = RGB(255, 128, 128)
                MsgBox Sheets("Лист2").Cells(i, 1).Address
[/vba]
 
Ответить
Сообщениевторой ответ не надо, спасибо, решил
[vba]
Код

Sheets("Лист2").Cells(i, 2).Interior.Color = RGB(255, 128, 128)
                Selection.Offset(0, 1).Interior.Color = RGB(255, 128, 128)
                MsgBox Sheets("Лист2").Cells(i, 1).Address
[/vba]

Автор - ant6729
Дата добавления - 16.05.2017 в 22:00
KuklP Дата: Вторник, 16.05.2017, 22:01 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 2214
Репутация: 472 ±
Замечаний: 0% ±

2003-2010
Вариант:
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    Application.EnableEvents = 0
    [a:a].ColumnDifferences(Target).EntireRow.Hidden = True
    UsedRange.Columns(2).SpecialCells(12).Interior.Color = RGB(255, 128, 128)
    Target(1, 2).Interior.ColorIndex = xlNone
    UsedRange.EntireRow.Hidden = False
    Application.EnableEvents = -1
End Sub
[/vba]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеВариант:
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    Application.EnableEvents = 0
    [a:a].ColumnDifferences(Target).EntireRow.Hidden = True
    UsedRange.Columns(2).SpecialCells(12).Interior.Color = RGB(255, 128, 128)
    Target(1, 2).Interior.ColorIndex = xlNone
    UsedRange.EntireRow.Hidden = False
    Application.EnableEvents = -1
End Sub
[/vba]

Автор - KuklP
Дата добавления - 16.05.2017 в 22:01
ant6729 Дата: Вторник, 16.05.2017, 22:17 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 304
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Интересная запись... надо понять будет как - нибудь...
Тоже, как вариант, спасибо!
 
Ответить
СообщениеИнтересная запись... надо понять будет как - нибудь...
Тоже, как вариант, спасибо!

Автор - ant6729
Дата добавления - 16.05.2017 в 22:17
Мир MS Excel » Вопросы и решения » Вопросы по VBA » НЕвыделение ячейки без дубликата по событию (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!