Страницы: 1
RSS
Пропустить пустые ячейки в диапазоне поиска (VBA), Подскажите комманду в VBA, которая игнорирует пустые строки в выбраном диапазоне
 
Добрый день.

Прошу помочь мне с решением задачи. Есть скрипт, который в выделенном диапазоне подсвечивает дубликаты попарно:
Код
Sub DuplicatesColoring()
     
    Dim Dupes()     'объявляем массив для хранения дубликатов
    ReDim Dupes(1 To Selection.Cells.Count, 1 To 2)
     
    Selection.Interior.ColorIndex = -4142   'убираем заливку если была
    i = 3
    For Each cell In Selection
        If WorksheetFunction.CountIf(Selection, cell.Value) > 1 Then
            For k = LBound(Dupes) To UBound(Dupes)
                'если ячейка уже есть в массиве дубликатов - заливаем
                If Dupes(k, 1) = cell Then cell.Interior.ColorIndex = Dupes(k, 2)
            Next k
            'если ячейка содержит дубликат, но еще не в массиве - добавляем ее в массив и заливаем
            If cell.Interior.ColorIndex = -4142 Then
                cell.Interior.ColorIndex = i
                Dupes(i, 1) = cell.Value
                Dupes(i, 2) = i
                i = i + 1
            End If
        End If
    Next cell
End Sub

Не могу найти такую команду, чтоб этот макрос игнорировал пустые ячейки  (вместо этого он разынми цветами заливает пустые ячейки).

Пробова запихнуть SkipBlanks: = True, но не могу угадать куда именно. (ещё толком не знаком с VBA)

В ячейках, по которым ведётся поиск есть формула ЕСЛИ, которая при значении ИСТИНА выводит номера автомобилей (значения, которые нужно попарно подсветить дубликаты), а при значении ЛОЖЬ выводит "" (пустая ячейка).
Изменено: zhmerin - 05.06.2018 10:41:04
 
Ну так перед тем как залить цветом проверяйте на <>""
Код
If Dupes(k, 1) = cell and cell.value<>"" THEN
Изменено: skais675 - 05.06.2018 10:59:10
 
Цитата
skais675 написал: перед тем как залить цветом проверяйте на <>""
И ещё на <>Empty. Т.к. пустая ячейка <> ячейка, содержащая пустую строку, а исходный массив состоит из Variant'ов.

zhmerin, ещё обратите внимание, что cell у Вас - сам объект Range, а не значение в ячейке. Лучше проверять и присваивать cell.Value (значение ячейки + формат) или даже cell.Value2 (значение ячейки без формата), а не cell.
Как-то так:
Код
    For Each cell In Selection
         If Not IsEmpty(cell.Value2) And cell.Value2 <> vbNullString Then 'Проверяем, что cell не пустая и не содержит пустую строку
         If WorksheetFunction.CountIf(Selection, cell.Value) > 1 Then
            For k = LBound(Dupes) To UBound(Dupes)
                'если ячейка уже есть в массиве дубликатов - заливаем
                If Dupes(k, 1) = cell.Value Then cell.Interior.ColorIndex = Dupes(k, 2)
            Next k
            'если ячейка содержит дубликат, но еще не в массиве - добавляем ее в массив и заливаем
            If cell.Interior.ColorIndex = -4142 Then
                cell.Interior.ColorIndex = i
                Dupes(i, 1) = cell.Value
                Dupes(i, 2) = i
                i = i + 1
            End If
        End If
        End If
    Next cell
Изменено: Irregular Expression - 05.06.2018 11:24:25
 
Irregular Expression, огромное спасибо, работает)!
 
Может так подойдет?
Код
Sub test()
    Dim arr(), rng, iarr
    Dim dic As Object, i&
    If Selection.Count = 1 Then Exit Sub
    arr = Selection.Value
    Set dic = CreateObject("Scripting.Dictionary")
    Selection.Interior.ColorIndex = -4142
    i = 3
    For Each rng In arr
        If Not IsEmpty(rng) Then dic.Item(CStr(rng)) = dic.Item(CStr(rng)) + 1
    Next rng
    For Each rng In dic.keys
        If dic.Item(rng) > 1 Then dic.Item(rng) = dic.Item(rng) & "|" & i: i = i + 1 Else dic.Remove (rng)
    Next rng
    For Each rng In Selection
        If dic.exists(CStr(rng.Value)) Then
            iarr = Split(dic.Item(CStr(rng.Value)), "|")
            If Val(iarr(0)) > 1 Then rng.Interior.ColorIndex = iarr(1)
        End If
    Next rng
End Sub
Изменено: Nordheim - 05.06.2018 12:30:39
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1
Наверх