Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Проверить столбцы на наличие дубликатов с выводом сообщения
 
#1
30.10.2023 15:55:47
Добрый день!
Подскажите, пожалуйста, как в код включить проверку на наличие дубликатов в двух столбцах
Код
'Столбец один из
Sheets(1).Range("W4:W" & m)
'В случае если есть хотя бы один дубликат, то вывести сообщение:
MsgBox "В столбце имеются дубликаты", vbCritical
'в противном случае
MsgBox "В столбце дубликаты отсутствуют", vbInformation
Подсвечивать дубликаты или удалять строки с ними не надо,
просто проверить на наличие и вывести соответствующую информацию.
 
 
 
#2
30.10.2023 16:18:55
Код
Sub test()
    Const m = 10

    If HasDupies(Sheets(1).Range("W4:W" & m)) Then
        MsgBox "В столбце имеются дубликаты", vbCritical
    Else
        MsgBox "В столбце дубликаты отсутствуют", vbInformation
    End If
End Sub

Private Function HasDupies(rr As Range) As Boolean
    If rr.Cells.CountLarge = 1 Then
        HasDupies = False
        MsgBox "Ты вообще нормальная?", vbQuestion
    Else
        Dim arr As Variant
        arr = rr.Value
        
        Dim dic As Object
        Set dic = CreateObject("Scripting.Dictionary")
        
        Dim vv As Variant
        For Each vv In arr
            If Not IsError(vv) Then
                If Not IsEmpty(vv) Then
                    If dic.Exists(vv) Then
                        HasDupies = True
                        Exit Function
                    Else
                        dic.Item(vv) = 0
                    End If
                End If
            End If
        Next
    End If
End Function
 
 
 
#3
30.10.2023 16:41:20
МатросНаЗебре, здравствуйте! Вы вновь вернули мне улыбку... :)
Это прекрасно, спасибо Вам огромное, желаю Вам счастливого дня...
Благодарю, благодарю...
 
 
 
#4
01.11.2023 18:04:14

Макрос МатросНаЗебре универсальный, есть проверка на пустые ячейки и ячейки с ошибками. Если таких ячеек нет, можно немного попроще. Макрос для выделенного диапазона.

Код
Sub enstaralfdh()
Dim Rg1 As Range
Set Rg1 = Selection
    If Rg1.Count = Application.WorksheetFunction.Sum(Application.CountIf(Rg1, Rg1)) Then
        MsgBox "В столбце дубликаты отсутствуют", vbInformation
    Else: MsgBox "В столбце имеются дубликаты", vbCritical
    End If
End Sub
 
 
 
#5
01.11.2023 19:26:13
Только счётесли() не со всеми значениями корректно работает. Как и суммесли(), как и УФ...
 
 
 
#6
01.11.2023 20:37:57
Писать лень, но через ADODB получить список уникальных из диапазона SQL запросом и сравнить количество полученных строк. ну разве что пустышки будут мешать, если есть. Тогда два запроса с исключением пустышек.
По вопросам из тем форума, личку не читаю.
 
 
 
#7
02.11.2023 20:57:15
БМВ
Цитата
Писать лень,
Полностью  с вами согласен. Я тоже не люблю много писать. Если в задании надо много писать не пишу, к тому не умею быстро на клавиатуре набирать. Сегодня целый день изучал функции, разбирался с формулами, которые мне написали, и заодно подправил предыдущий макрос, чтобы не  учитывал пустые ячейки и ячейки с ошибками.
Код
Sub ProverkaDublicat()
Dim Rg1 As Range, NotBlank&, kErr&, kNotDub&
Set Rg1 = Selection
    If Rg1.Cells.Count = 1 Then Exit Sub
NotBlank = Application.CountA(Rg1)
kErr = UBound(Filter(Application.Transpose(Application.IsError(Rg1)), True)) + 1
kNotDub = UBound(Filter(Application.Transpose(Application.CountIf(Rg1, Rg1)), 1)) + 1
    If NotBlank - kErr = kNotDub Then
        MsgBox "В Диапазоне дубликаты отсутствуют", vbInformation
    Else: MsgBox "В Диапазоне имеются дубликаты", vbCritical
    End If
End Sub 'Пустые ячейки и ошибки не учитываются
 
 
 
Страницы: 1
Наверх