Помогите, пожалуйста, в написании макроса. Условно, есть 3 проверяемых столбца: "Отчетная дата", "Номер" и "Код", четвертный столбец - для результатов работы макроса.
По условиям работы макроса: 1) Значение столбца "Код" = "И1" 2) Значение столбца "Номер" = уникальное за ту дату, которая указана в столбце "Отчетная дата". Если все условия подходят - в столбце "Проверка" проставляется 1, если нет - то ячейка остается пустой.
Набросал рядом формулу, которая работает так, как должен отрабатывать макрос. Ее проблема заключается в том, что на больших массивах она завешивает файл вычислениями.
Доброе утро, уважаемые!
Помогите, пожалуйста, в написании макроса. Условно, есть 3 проверяемых столбца: "Отчетная дата", "Номер" и "Код", четвертный столбец - для результатов работы макроса.
По условиям работы макроса: 1) Значение столбца "Код" = "И1" 2) Значение столбца "Номер" = уникальное за ту дату, которая указана в столбце "Отчетная дата". Если все условия подходят - в столбце "Проверка" проставляется 1, если нет - то ячейка остается пустой.
Набросал рядом формулу, которая работает так, как должен отрабатывать макрос. Ее проблема заключается в том, что на больших массивах она завешивает файл вычислениями.ArkaIIIa
Сочетание 30.03.2015 1/0002679 не является уникальным, там две такие пары. Т.е. или формулировка ошибочна, или там не должно быть единицы. Вероятно думали не о уникальном, а о первом встреченном таком сочетании? Вообще легко делается на словаре или в данном случае на коллекции.
На словаре проще код: [vba]
Код
Sub tt() Dim a(), i&, t$
With CreateObject("Scripting.Dictionary"): .comparemode = 1 a = [a1].CurrentRegion.Columns(1).Resize(, 3).Value ReDim b(1 To UBound(a), 1 To 1) For i = 2 To UBound(a) If a(i, 3) = "И1" Then t = a(i, 1) & "|" & a(i, 2) If Not .exists(t) Then b(i, 1) = 1: .Item(t) = 0& End If Next End With
b(1, 1) = "Проверка макросом" [f1].Resize(UBound(b), 1) = b End Sub
[/vba]
Сочетание 30.03.2015 1/0002679 не является уникальным, там две такие пары. Т.е. или формулировка ошибочна, или там не должно быть единицы. Вероятно думали не о уникальном, а о первом встреченном таком сочетании? Вообще легко делается на словаре или в данном случае на коллекции.
На словаре проще код: [vba]
Код
Sub tt() Dim a(), i&, t$
With CreateObject("Scripting.Dictionary"): .comparemode = 1 a = [a1].CurrentRegion.Columns(1).Resize(, 3).Value ReDim b(1 To UBound(a), 1 To 1) For i = 2 To UBound(a) If a(i, 3) = "И1" Then t = a(i, 1) & "|" & a(i, 2) If Not .exists(t) Then b(i, 1) = 1: .Item(t) = 0& End If Next End With
b(1, 1) = "Проверка макросом" [f1].Resize(UBound(b), 1) = b End Sub
Hugo Что-то я туплю сверх меры. Пытаюсь адаптировать макрос под "большой" файл, и не получается. Отличие от файла-примера: "Отчетная дата" = столбец B, "Номер" = столбец "E", "Код" = столбец F, вставлять значения в столбец AH. Ты не мог бы прописать это в своем коде?)
Hugo Что-то я туплю сверх меры. Пытаюсь адаптировать макрос под "большой" файл, и не получается. Отличие от файла-примера: "Отчетная дата" = столбец B, "Номер" = столбец "E", "Код" = столбец F, вставлять значения в столбец AH. Ты не мог бы прописать это в своем коде?)ArkaIIIa
Нет. Нужно сразу показывать реальные данные в реальном расположении. Сейчас уже времени нет, тем более что опять гадать без файла никакой гарантии успеха нет.
Нет. Нужно сразу показывать реальные данные в реальном расположении. Сейчас уже времени нет, тем более что опять гадать без файла никакой гарантии успеха нет.Hugo
Sub tt() Dim a(), aa(), i&, t$ With CreateObject("Scripting.Dictionary"): .comparemode = 1 a = [b1].CurrentRegion.Value aa = [b1].CurrentRegion.Offset(, 3).Resize(, 2).Value ReDim b(1 To UBound(a), 1 To 1) For i = 2 To UBound(a) If aa(i, 2) = "И1" Then t = a(i, 1) & "|" & aa(i, 1) If Not .exists(t) Then b(i, 1) = 1: .Item(t) = 0& End If Next End With
b(1, 1) = "Проверка" [ah1].Resize(UBound(b), 1) = b End Sub
[/vba] Но я уверен, что и это в реальном файле не заработает
[vba]
Код
Sub tt() Dim a(), aa(), i&, t$ With CreateObject("Scripting.Dictionary"): .comparemode = 1 a = [b1].CurrentRegion.Value aa = [b1].CurrentRegion.Offset(, 3).Resize(, 2).Value ReDim b(1 To UBound(a), 1 To 1) For i = 2 To UBound(a) If aa(i, 2) = "И1" Then t = a(i, 1) & "|" & aa(i, 1) If Not .exists(t) Then b(i, 1) = 1: .Item(t) = 0& End If Next End With
b(1, 1) = "Проверка" [ah1].Resize(UBound(b), 1) = b End Sub
[/vba] Но я уверен, что и это в реальном файле не заработает Hugo
Hugo "И это в реальном файле не работает", потому что в реальном файле столбцы A,C,D тоже заполнены данными. Мне казалось, что макрос на этом не должен будет споткнуться. Ты меня извини, Хьюго. Я совсем олень в VBA, по этому вроде бы простую задачу с третьего раза только более-менее описываю.
Hugo "И это в реальном файле не работает", потому что в реальном файле столбцы A,C,D тоже заполнены данными. Мне казалось, что макрос на этом не должен будет споткнуться. Ты меня извини, Хьюго. Я совсем олень в VBA, по этому вроде бы простую задачу с третьего раза только более-менее описываю.ArkaIIIa
Значит вместо компактного CurrentRegion нужно определять этот диапазон иначе... [vba]
Код
Sub tt() Dim r As Range, a(), aa(), i&, t$ With CreateObject("Scripting.Dictionary"): .comparemode = 1 Set r = Range([b1], Cells(Rows.Count, "b").End(xlUp)) a = r.Value aa = r.Offset(, 3).Resize(, 2).Value ReDim b(1 To UBound(a), 1 To 1) For i = 2 To UBound(a) If aa(i, 2) = "И1" Then t = a(i, 1) & "|" & aa(i, 1) If Not .exists(t) Then b(i, 1) = 1: .Item(t) = 0& End If Next End With
b(1, 1) = "Проверка" [ah1].Resize(UBound(b), 1) = b End Sub
[/vba]
Значит вместо компактного CurrentRegion нужно определять этот диапазон иначе... [vba]
Код
Sub tt() Dim r As Range, a(), aa(), i&, t$ With CreateObject("Scripting.Dictionary"): .comparemode = 1 Set r = Range([b1], Cells(Rows.Count, "b").End(xlUp)) a = r.Value aa = r.Offset(, 3).Resize(, 2).Value ReDim b(1 To UBound(a), 1 To 1) For i = 2 To UBound(a) If aa(i, 2) = "И1" Then t = a(i, 1) & "|" & aa(i, 1) If Not .exists(t) Then b(i, 1) = 1: .Item(t) = 0& End If Next End With
b(1, 1) = "Проверка" [ah1].Resize(UBound(b), 1) = b End Sub
Hugo Да, вот сейчас - все отлично работает на рабочем файле! Еще раз спасибо большое, и извиняюсь, что отнял так много времени невнятными формулировками. Буду работать над собой)
Hugo Да, вот сейчас - все отлично работает на рабочем файле! Еще раз спасибо большое, и извиняюсь, что отнял так много времени невнятными формулировками. Буду работать над собой)ArkaIIIa
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
