Страницы: 1 2 След.
RSS
Поиск дубликатов в КНИГЕ
 
В стандартных средствах Excel существует "поиск дубликатов", недостаток этого помощника в том, что он ищет по листу и его нельзя настроить на аналогичный поиск дубликатов по книге.В книге несколько листов с подобными данными (списки людей) Есть ли возможность решить такую задачу?
 
макросом
Согласие есть продукт при полном непротивлении сторон
 
Вот пример. Только строк в таблице может быть до 1500  
 
Цитата
"поиск дубликатов"
Где такое в "Стандартных средствах Excel"? Знаю "Удалить дубликаты" и в условном форматировании Выделить- "повторяющиеся значения", а поиск где? Что хотите получить после того как найдете одинаковые в книге?
Да есть еще "Найти" -Ctrl+F, но с помощью этого поиска можно найти во всей книге.
Изменено: gling - 09.03.2015 22:49:07
 
Извините, неправильно написала - вы абсолютно правы. В условном форматировании есть "повторяющиеся значения", которые к сожалению работают только в пределах одного листа.
 
owl-ka, так с дубликатами что надо сделать? просто выдать напортив каждого сколько дубликатов найдено для этого ФИО ? И всегда будет в столбце С то что дубликаты чего ищутся?
Работать надо не 12 часов, а головой.
 
идеальный вариант - указать адрес второго значения. Подойдет даже просто указать цветом. Удалять нельзя, вдруг разные люди!
 
что значит адрес? адрес ячейки с листом? а если дубликата 4 то всё указывать?
Работать надо не 12 часов, а головой.
 
Я не подумала, в моей практике больше 2-х не встречалось, думаю больше и не встретится
 
Может тогда через "Найти" действовать, там и лист и сразу переход на лист можно использовать.
 
если установить условное форматирование, то на одном листе сразу будет высвечиваться повторяющиеся данные, а вот если этот человек на другом листе, можно и не уследить, а так как людей много.... Одним словом если кто-то переезжает с общежития в другое или на квартиру а то и обратно, можно его внести во все списки
 
Вот так можно. Смотрите вложение.
Работать надо не 12 часов, а головой.
 
а можно попросить еще немного модернизировать - выделение неядовитым цветом (просто столбец D я скрою).
 
Можно
Изменено: Leanna - 09.03.2015 23:34:58 (замена файла)
Работать надо не 12 часов, а головой.
 
Можно УФ сделать на все листы. Если на первом листе будет список всех, то на других листах можно увидеть есть ли они в списке. Наверно нужно наоборот, если на любом из листов есть, то в списке чтобы выделился. Пока такой вариант. Лучше конечно Ваш пример, чтобы видеть о чем речь.
Изменено: gling - 09.03.2015 23:31:34
 
Leanna , спасибо, это как раз то, что нужно!!!!

gling,  предложение интересное, вот только нужно время на то, чтобы их собрать, на один лист. А информация нужна не об общем количестве людей, а именно по листам. Примерно так - общежитие 1 - 10 семей, 20 человек,
общежитие 2 - 5 семей, 15 человек,
....................................................
квартиры - 100 семей, 250 человек,

Каждый лист соответствует определенному жилью. Если переносить на один лист, нужно будет делать суммарную нумерацию по людям и по семьям. По людям просто, а по семьям так не получится - только ручками.
 
Люди спасите и помогите!!!! Все форумы облазил... везде пишут поиск дубликатов в одном или максимум в двух столбцах... мне нужно найти и ПОСЧИТАТЬ все дубликаты в целой области (около 100 строк и около 30 столбцов)
дубликаты (текстовые) заранее не известны(((
А мне нужно узнать значения эти текстовые и сколько раз они повторяются...
 
Код
Sub FindDuplicates()
Dim Dict As Object, aa As Range, arr()
Set Dict = CreateObject("Scripting.Dictionary")
For Each aa In Sheets(1).UsedRange
  If Len(aa.Value) > 0 Then
    If Not Dict.exists(aa.Value) Then
      Dict.Add aa.Value, 1
    Else
      Dict.Item(aa.Value) = Dict.Item(aa.Value) + 1
    End If
  End If
Next
On Error Resume Next
Set aa = Application.InputBox("Select distination cell.", , , , , , , 8)
If Err.Number > 0 Then Set aa = [AA1]
On Error GoTo 0
If aa.Cells.Count > 1 Then Set aa = Range(Left(aa.Address, InStr(":", aa.Address) - 1))
aa.Resize(Dict.Count) = Application.Transpose(Dict.keys)
aa.Offset(0, 1).Resize(Dict.Count) = Application.Transpose(Dict.items)
End Sub
 
Anchoret, вот такая фигня вылазит(

Спасибо за быстрое реагирование!)
Изменено: Okl - 05.03.2019 00:50:33
 
Okl, перед размещением на форум код проверялся. Ошибок не было.
 
Anchoret,А пример файла с этим макросом можно?
 
Цитата
Okl написал: А пример файла с этим макросом можно?
Можно. Ознакомьтесь с Правилами и приложите файл-пример в соответствии с ними
Согласие есть продукт при полном непротивлении сторон
 
Okl, вот
 
Anchoret, Ваш шикарный макрос у меня выдаёт ошибку в строке
Код
If aa.Cells.Count > 1 Then Set aa = Range(Left(aa.Address, InStr(":", aa.Address) - 1))

И вообще у меня это часто почему-то. Многие работающие примеры макросов с сайта у меня выдают ошибки. В чём может быть причина?

 
Andr85, как раз эту часть не тестировал. И раз Вас туда занесло, то вместо одной ячейки для левого верхнего угла вставки Вы выбрали несколько ячеек. Место вставки можно прописать жестко:
Код
set aa=sheets("....").[A1]' это только для примера и вместо точек должно быть имя листа

Также вместо "UsedRange"  в начале кода можно указать откуда макросу брать данные. Например "Selection" или "[A2:J5500]"

Изменено: Anchoret - 11.03.2018 20:31:09
 
Уважаемые эксперты, в продолжение темы, пытаюсь настроить макрос на поиск дубликатов на всех листах книги в диапазоне H:I, кроме листа Сводная, но, видимо, совсем всё сломалось, код стал выводить ошибку в строке: aa.Resize(Dict.Count) = Application.Transpose(Dict.keys)  

Обходить лист Сводная вроде получилось, а определить диапазон нет, результат хотел бы получать на лист Сводная!C2

сам код и файл здесь:
Код
Sub FindDuplicates()

       ' Declare Current as a worksheet object variable.
         Dim Current As Worksheet


Dim Dict As Object, aa As Range, arr()
Set Dict = CreateObject("Scripting.Dictionary")
         
         ' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
For Each aa In Sheets(1).Range("H2:I60000") '[H2:I60000]
If aa <> "Сводная" Then
  If Len(aa.Value) > 0 Then
    If Not Dict.exists(aa.Value) Then
      Dict.Add aa.Value, 1
    Else
      Dict.Item(aa.Value) = Dict.Item(aa.Value) + 1
    End If
  End If
End If
Next
Next


On Error Resume Next
Set aa = Application.InputBox("Select distination cell.", , , , , , , 8)
If aa <> "Сводная" Then
If Err.Number > 0 Then Set aa = [AA1]
On Error GoTo 0
If aa.Cells.Count > 1 Then Set aa = Range(Left(aa.Address, InStr(":", aa.Address) - 1))
aa.Resize(Dict.Count) = Application.Transpose(Dict.keys)
aa.Offset(0, 1).Resize(Dict.Count) = Application.Transpose(Dict.items)
End If

End Sub
 
Дмитрий Марков,  ошибка потому что словарь получается пустой.
Чтоб его заполнить - нужно не только перебирать листы, но и их ячейки!
Код
For Each aa In Current.Range("H2:I60000")

P.S. Я бы не использовал слово Current как имя переменной...
Изменено: Hugo - 05.03.2019 00:35:19
 
Hugo, не удивлен, насколько быстро Вы указали на причину и на ошибку. Большое Вам спасибо! Всё отлично посчиталось, продолжаю осваивать vba      
 
Цитата
Hugo написал:
P.S. Я бы не использовал слово Current как имя переменной...
За рекомендацию отдельное спасибо!
 
Есть похожая задача.
Книга с большим количеством листов. И надо при вводе нового значения в столбце А, отловить, есть ли уже такое же значение в книге на любом из её листов также в столбцах А.
Можно, наверное, подключить УФ с нескольких листов, но количество листов постоянно растёт и каждый раз подключать всё новые и новые листы в УФ - не самый простой вариант.
Хотел решить это с помощью макроса, попытался подключить те макросы, которые приводились здесь, но у меня ничего не заработало :(. К сожалению, я вообще не специалист в VBA
Возможно кто-то сможет мне помочь? Буду очень признателен.
Страницы: 1 2 След.
Наверх