Доброго времени суток! Уважаемые форумчане помогите в решении задачки Необходимо посчитать количество дубликатов в столбце, которые выделяются условным форматированием и вывести количество в ячейку
Доброго времени суток! Уважаемые форумчане помогите в решении задачки Необходимо посчитать количество дубликатов в столбце, которые выделяются условным форматированием и вывести количество в ячейкуrtv206
Подскажите, пожалуйста, других способов нет? Очень сильно тормозит при большом количестве значений. Макросом например считать количество ячеек с условным форматированием?
Подскажите, пожалуйста, других способов нет? Очень сильно тормозит при большом количестве значений. Макросом например считать количество ячеек с условным форматированием?rtv206
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content][Столбец1], dupl = Table.FromRecords({[Дубликаты =List.Count(Источник)-List.Count(List.Distinct(Источник))]}) in dupl
let Источник = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content][Столбец1], dupl = Table.FromRecords({[Дубликаты =List.Count(Источник)-List.Count(List.Distinct(Источник))]}) in dupl
Sub KolDub() c_ = 1 r0_ = 1 n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1 ar = Cells(r0_, c_).Resize(n_) Set slov1 = CreateObject("Scripting.Dictionary") Set slov2 = CreateObject("Scripting.Dictionary") With slov1 For i = 1 To n_ If .exists(ar(i, 1)) Then z_ = z_ + 1 aaa = slov2.Item(ar(i, 1)) Else aaa = .Item(ar(i, 1)) End If Next i End With Cells(1, 6) = z_ + slov2.Count End Sub
[/vba]
Ловите макросом с кнопки [vba]
Код
Sub KolDub() c_ = 1 r0_ = 1 n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1 ar = Cells(r0_, c_).Resize(n_) Set slov1 = CreateObject("Scripting.Dictionary") Set slov2 = CreateObject("Scripting.Dictionary") With slov1 For i = 1 To n_ If .exists(ar(i, 1)) Then z_ = z_ + 1 aaa = slov2.Item(ar(i, 1)) Else aaa = .Item(ar(i, 1)) End If Next i End With Cells(1, 6) = z_ + slov2.Count End Sub
Если ответов нет, то скорее всего что-то не так в вопросе. В Вашем вопросе по крайней мере два нетака - 1, Нет файла-примера с данными в столбцах Е:Z 2. Не определено понятие дубликатов в разных столбцах - если в столбце Е значения а,в,в; в столбце F значения с,d,а, то понятно, что в - дубликат, но вот дубликат ли а?
Если ответов нет, то скорее всего что-то не так в вопросе. В Вашем вопросе по крайней мере два нетака - 1, Нет файла-примера с данными в столбцах Е:Z 2. Не определено понятие дубликатов в разных столбцах - если в столбце Е значения а,в,в; в столбце F значения с,d,а, то понятно, что в - дубликат, но вот дубликат ли а?_Boroda_
2. Не определено понятие дубликатов в разных столбцах - если в столбце Е значения а,в,в; в столбце F значения с,d,а, то понятно, что в - дубликат, но вот дубликат ли а?
2. Не определено понятие дубликатов в разных столбцах - если в столбце Е значения а,в,в; в столбце F значения с,d,а, то понятно, что в - дубликат, но вот дубликат ли а?
Sub KolDub() c0_ = 5 nc_ = Cells(1).SpecialCells(xlLastCell).Column - c0_ + 1 If nc_ < 1 Then Exit Sub r0_ = 1 nr_ = Cells(1).SpecialCells(xlLastCell).Row - r0_ + 1 If nr_ < 1 Then Exit Sub ar = Cells(r0_, c0_).Resize(nr_, nc_) Set slov1 = CreateObject("Scripting.Dictionary") Set slov2 = CreateObject("Scripting.Dictionary") With slov1 For i = 1 To nr_ For j = 1 To nc_ If Not IsEmpty(ar(i, j)) Then If .exists(ar(i, j)) Then z_ = z_ + 1 aaa = slov2.Item(ar(i, j)) Else aaa = .Item(ar(i, j)) End If End If Next j Next i End With Cells(1, 2) = z_ + slov2.Count End Sub
[/vba]
Во, другое дело! Так хотели? [vba]
Код
Sub KolDub() c0_ = 5 nc_ = Cells(1).SpecialCells(xlLastCell).Column - c0_ + 1 If nc_ < 1 Then Exit Sub r0_ = 1 nr_ = Cells(1).SpecialCells(xlLastCell).Row - r0_ + 1 If nr_ < 1 Then Exit Sub ar = Cells(r0_, c0_).Resize(nr_, nc_) Set slov1 = CreateObject("Scripting.Dictionary") Set slov2 = CreateObject("Scripting.Dictionary") With slov1 For i = 1 To nr_ For j = 1 To nc_ If Not IsEmpty(ar(i, j)) Then If .exists(ar(i, j)) Then z_ = z_ + 1 aaa = slov2.Item(ar(i, j)) Else aaa = .Item(ar(i, j)) End If End If Next j Next i End With Cells(1, 2) = z_ + slov2.Count End Sub
_Boroda_, используя макрос из Сообщение № 14 Количество значений 110236 подсчет дубликатов идет 3,5 минуты. Все условное форматирование отключено. Вес файла 600 кБ. Прикладываю ссылку на ГуглДиск My WebPage
_Boroda_, используя макрос из Сообщение № 14 Количество значений 110236 подсчет дубликатов идет 3,5 минуты. Все условное форматирование отключено. Вес файла 600 кБ. Прикладываю ссылку на ГуглДиск My WebPagertv206
Поменял порядок циклов, и погонял. Результат не утешительный. [vba]
Код
Sub KolDub() Dim t!, tt! t = Timer c0_ = 5 nc_ = Cells(1).SpecialCells(xlLastCell).Column - c0_ + 1 If nc_ < 1 Then Exit Sub r0_ = 1 nr_ = Cells(1).SpecialCells(xlLastCell).Row - r0_ + 1 If nr_ < 1 Then Exit Sub ar = Cells(r0_, c0_).Resize(nr_, nc_) Set slov1 = CreateObject("Scripting.Dictionary") Set slov2 = CreateObject("Scripting.Dictionary") tt = Timer With slov1 For j = 1 To nc_ For i = 1 To nr_ If Not IsEmpty(ar(i, j)) Then If .exists(ar(i, j)) Then z_ = z_ + 1 aaa = slov2.Item(ar(i, j)) Else aaa = .Item(ar(i, j)) End If End If Next Debug.Print j & "j " & Format(Timer - tt, "0.00") tt = Timer DoEvents Next
End With Debug.Print "end " & Format(Timer - t, "0.00") Cells(1, 2) = z_ + slov2.Count End Sub
[/vba] 1j 0,40 2j 1,16 3j 1,88 4j 2,65 5j 3,53 6j 4,60 7j 5,66 8j 6,51 9j 7,34 10j 8,14 11j 8,98 12j 9,80 13j 10,63 14j 11,53 15j 12,31 16j 13,20 17j 13,98 18j 14,82 19j 15,73 20j 16,47 21j 17,27 22j 18,11 23j 18,92 24j 20,02 25j 22,44 26j 21,63 27j 22,48 28j 19,68 29j 20,22 30j 20,85 31j 21,53 end 392,59 При этом, волею судеб _Boroda_, последние 4 столбца пустые, и время на их обработку меня вообще ставит в тупик.
Поменял порядок циклов, и погонял. Результат не утешительный. [vba]
Код
Sub KolDub() Dim t!, tt! t = Timer c0_ = 5 nc_ = Cells(1).SpecialCells(xlLastCell).Column - c0_ + 1 If nc_ < 1 Then Exit Sub r0_ = 1 nr_ = Cells(1).SpecialCells(xlLastCell).Row - r0_ + 1 If nr_ < 1 Then Exit Sub ar = Cells(r0_, c0_).Resize(nr_, nc_) Set slov1 = CreateObject("Scripting.Dictionary") Set slov2 = CreateObject("Scripting.Dictionary") tt = Timer With slov1 For j = 1 To nc_ For i = 1 To nr_ If Not IsEmpty(ar(i, j)) Then If .exists(ar(i, j)) Then z_ = z_ + 1 aaa = slov2.Item(ar(i, j)) Else aaa = .Item(ar(i, j)) End If End If Next Debug.Print j & "j " & Format(Timer - tt, "0.00") tt = Timer DoEvents Next
End With Debug.Print "end " & Format(Timer - t, "0.00") Cells(1, 2) = z_ + slov2.Count End Sub
[/vba] 1j 0,40 2j 1,16 3j 1,88 4j 2,65 5j 3,53 6j 4,60 7j 5,66 8j 6,51 9j 7,34 10j 8,14 11j 8,98 12j 9,80 13j 10,63 14j 11,53 15j 12,31 16j 13,20 17j 13,98 18j 14,82 19j 15,73 20j 16,47 21j 17,27 22j 18,11 23j 18,92 24j 20,02 25j 22,44 26j 21,63 27j 22,48 28j 19,68 29j 20,22 30j 20,85 31j 21,53 end 392,59 При этом, волею судеб _Boroda_, последние 4 столбца пустые, и время на их обработку меня вообще ставит в тупик.RAN
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
