Добрый день. Необходимо написать макрос, который в столбце F «Проверка» поставит слово «да» для уникальных значений по 4-м столбца: B-C-D-E То есть необходимо сравнить строки по 4 столбцам
Добрый день. Необходимо написать макрос, который в столбце F «Проверка» поставит слово «да» для уникальных значений по 4-м столбца: B-C-D-E То есть необходимо сравнить строки по 4 столбцамAndrew87
CC = R.Columns.Count RC = R.Rows.Count For i = 1 To RC For j = 1 To CC S = R.Cells(i, j).Value For l = i To RC For m = j To CC SS = R.Cells(l, m).Value If (SS = S) And Not ((l - i) + (m - j) = 0) Then AllUnique = False Exit Function End If Next m Next l Next j Next i
End Function
[/vba]
[vba]
Код
Public Function AllUnique(R As Range) As Boolean
Dim S, SS As String
AllUnique = True
CC = R.Columns.Count RC = R.Rows.Count For i = 1 To RC For j = 1 To CC S = R.Cells(i, j).Value For l = i To RC For m = j To CC SS = R.Cells(l, m).Value If (SS = S) And Not ((l - i) + (m - j) = 0) Then AllUnique = False Exit Function End If Next m Next l Next j Next i
abtextime, Спасибо. Приложил файл для наглядности, фишка заключается в том, что если в любом из столбцов уникальное значение, то вся строка считается уникальной и ставится "да"
abtextime, Спасибо. Приложил файл для наглядности, фишка заключается в том, что если в любом из столбцов уникальное значение, то вся строка считается уникальной и ставится "да"Andrew87
Andrew87, у Вас в примере при наличии нескольких повторений (т.е. по здравому смыслу вроде нет уникальности) одно из таких повторений, тем не менее, отмечается как "да". Это существенный момент, о котором Вы умалчиваете в постановке задачи. Кстати, какую именно из таких неуникальных записей метить как "да"? Самую последнюю?
P.S. Просто, если можно было бы метить первую, то и программирования никакого не надо. Идёте по меню: Данные \ Сортировка и фильтр \ Дополнительно \ попадаем в "Расширенный фильтр" \ отмечаем "Фильтровать на месте", исходный диапазон: $A$1:$D$13, отмечаем "Только уникальные записи" \ Ok. После фильтрации прописываем слово "да" в верхнюю ячейку колонки E (поставить да) и, не снимая фильтра, копируем "да" ниже. Очищаем фильтр - вуаля!
P.P.S. А если макросом пренепременно, то он может быть таким ("по мотивам" ручных операций): [vba]
Код
Sub МакросДа() Dim rng As Range Set rng = Range(Range("A1:D1"), Range("A1:D1").End(xlDown)) rng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rng, Unique:=True rng.Offset(1, rng.Columns.Count).Resize(rng.Rows.Count - 1, 1) = "да" rng.Worksheet.ShowAllData End Sub
[/vba]
Andrew87, у Вас в примере при наличии нескольких повторений (т.е. по здравому смыслу вроде нет уникальности) одно из таких повторений, тем не менее, отмечается как "да". Это существенный момент, о котором Вы умалчиваете в постановке задачи. Кстати, какую именно из таких неуникальных записей метить как "да"? Самую последнюю?
P.S. Просто, если можно было бы метить первую, то и программирования никакого не надо. Идёте по меню: Данные \ Сортировка и фильтр \ Дополнительно \ попадаем в "Расширенный фильтр" \ отмечаем "Фильтровать на месте", исходный диапазон: $A$1:$D$13, отмечаем "Только уникальные записи" \ Ok. После фильтрации прописываем слово "да" в верхнюю ячейку колонки E (поставить да) и, не снимая фильтра, копируем "да" ниже. Очищаем фильтр - вуаля!
P.P.S. А если макросом пренепременно, то он может быть таким ("по мотивам" ручных операций): [vba]
Код
Sub МакросДа() Dim rng As Range Set rng = Range(Range("A1:D1"), Range("A1:D1").End(xlDown)) rng.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rng, Unique:=True rng.Offset(1, rng.Columns.Count).Resize(rng.Rows.Count - 1, 1) = "да" rng.Worksheet.ShowAllData End Sub
Gustav, По фильтру это да, но у меня к сожалению задача макрос и сам немного не понимаю, что второе повторение считается уникальным. Если в строке по какому то из столбцов есть различие то строка уникальна. Буду разбираться.
Gustav, По фильтру это да, но у меня к сожалению задача макрос и сам немного не понимаю, что второе повторение считается уникальным. Если в строке по какому то из столбцов есть различие то строка уникальна. Буду разбираться.Andrew87
Andrew87, добрый вечер,попробуйте макросы,кнопки aaa1 и aaa2 в файл-примере
[vba]
Код
Sub aaa1() Dim z(), z1(), i&, t$ z = Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).Value ReDim z1(1 To UBound(z), 1 To 1) With CreateObject("scripting.dictionary"): .comparemode = 1 For i = 2 To UBound(z): t = z(i, 1) & z(i, 2) & z(i, 3) & z(i, 4) If Not .exists(t) Then .Item(t) = 0: z1(i, 1) = "да" Next Range("E1").Resize(UBound(z1)) = z1 End With End Sub
[/vba]
Andrew87, добрый вечер,попробуйте макросы,кнопки aaa1 и aaa2 в файл-примере
[vba]
Код
Sub aaa1() Dim z(), z1(), i&, t$ z = Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).Value ReDim z1(1 To UBound(z), 1 To 1) With CreateObject("scripting.dictionary"): .comparemode = 1 For i = 2 To UBound(z): t = z(i, 1) & z(i, 2) & z(i, 3) & z(i, 4) If Not .exists(t) Then .Item(t) = 0: z1(i, 1) = "да" Next Range("E1").Resize(UBound(z1)) = z1 End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
