Приветствую всех. Сделал таблицу в которую сотрудники периодически вносят данные по инспектированию через форму пользователя. Но бывают ситуации когда данные поступают с опозданием или из разных источников и в таблицу могут попасть записи уже внесённые данные. У меня не получается организовать контроль наличия записи на этапе ввода данных. Контроль достаточно организовать по № договора, марке тепловоза и дате проведения инспектирования. Если эти три параметра, взятые из одной строки, совпадают то ввод остальной информации надо прервать и проинформировать оператора, что такая запись уже есть. У меня (на этапе моделирования) получилось загнать контролируемые данные из таблицы (три столбца) в массив, при вводе в ТексБоксы контролировать их наличие перебором значений массива, но не получается их соотнести только к одной строке. Например, сочетание 015-24+ТГМ4-0169+15.01.24 должно быть уникальным (из-за даты) и повторный ввод с таким сочетанием необходимо прервать. Возможно, я выбрал не правильный подход к решению этой задачи, хотя искал и пробывал несколько методов, заходя в тупик. Буду благодарен за помощь. Файл примера прилагаю.
Приветствую всех. Сделал таблицу в которую сотрудники периодически вносят данные по инспектированию через форму пользователя. Но бывают ситуации когда данные поступают с опозданием или из разных источников и в таблицу могут попасть записи уже внесённые данные. У меня не получается организовать контроль наличия записи на этапе ввода данных. Контроль достаточно организовать по № договора, марке тепловоза и дате проведения инспектирования. Если эти три параметра, взятые из одной строки, совпадают то ввод остальной информации надо прервать и проинформировать оператора, что такая запись уже есть. У меня (на этапе моделирования) получилось загнать контролируемые данные из таблицы (три столбца) в массив, при вводе в ТексБоксы контролировать их наличие перебором значений массива, но не получается их соотнести только к одной строке. Например, сочетание 015-24+ТГМ4-0169+15.01.24 должно быть уникальным (из-за даты) и повторный ввод с таким сочетанием необходимо прервать. Возможно, я выбрал не правильный подход к решению этой задачи, хотя искал и пробывал несколько методов, заходя в тупик. Буду благодарен за помощь. Файл примера прилагаю.Shylo
Добрый день. Возможно будет проще проконтролировать совпадения не на этапе ввода в форму, а на этапе внесения в ячейки. Минус для тех, кто вносит ... но для организации проверки может стать плюсом.
Добрый день. Возможно будет проще проконтролировать совпадения не на этапе ввода в форму, а на этапе внесения в ячейки. Минус для тех, кто вносит ... но для организации проверки может стать плюсом.WowGun
Добрый день. Вы праваы. Так именно на этапе ввода я и хочу реализовать. Файл с примером это как черновик для отработки. Т.е. в процессе вводе через форму при заполнении соответствующих текстбоксов и по процедуре выхода из TextBox3 выполняется алгоритм проверки с принятием соответственного решения.
Добрый день. Вы праваы. Так именно на этапе ввода я и хочу реализовать. Файл с примером это как черновик для отработки. Т.е. в процессе вводе через форму при заполнении соответствующих текстбоксов и по процедуре выхода из TextBox3 выполняется алгоритм проверки с принятием соответственного решения.Shylo
Так и попробуйте прикрутить Worksheet_Change к выходу из формы ... или просто удалением последней введеной строки [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Or Target.Column = 2 Or Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Then r = Target.row n1 = Range("B" & r) n2 = Range("C" & r) n3 = Range("D" & r) n4 = Range("E" & r) For I = 2 To r If Range("B" & I) = n1 And Range("C" & I) = n2 And Range("D" & I) = n3 And Range("E" & I) = n4 And I <> r Then Range(I & ":" & I).Select MsgBox ("Такие данные находятся в строке " & I) End If Next End If End Sub
[/vba]
Данный код не защищает от ручного изменения существующих записей.
Так и попробуйте прикрутить Worksheet_Change к выходу из формы ... или просто удалением последней введеной строки [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Or Target.Column = 2 Or Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Then r = Target.row n1 = Range("B" & r) n2 = Range("C" & r) n3 = Range("D" & r) n4 = Range("E" & r) For I = 2 To r If Range("B" & I) = n1 And Range("C" & I) = n2 And Range("D" & I) = n3 And Range("E" & I) = n4 And I <> r Then Range(I & ":" & I).Select MsgBox ("Такие данные находятся в строке " & I) End If Next End If End Sub
[/vba]
Данный код не защищает от ручного изменения существующих записей.WowGun
УЧИТЕСЬ ... спрашивать.
Сообщение отредактировал WowGun - Пятница, 21.06.2024, 19:35
WowGun, насколько я понял Ваш код привязан к событиям листа, а оно произойдот только после нажатия кнопки ввода, то есть по факту дублирующая запись может появиться. Я себе представляю себе так: при инициализации формы создается массив из данных трех столбцов, после вода трех ключевых параметров (договор+тепловоз+дата) в текстбоксы данные сравниваются с записями в массиве но обязательно построчно (это то, что у меня не получается) и если выполняется условие равенства трех записей (And) то выходим из процедуры (формы) с меседжем. Ввод всех внесенных на форму данных на лист выполняется одновременно, как и в файле-примере. Я только начал разбираться в цыклах и не знаю как организовать перебор массива по индексам столбцов в строках для поиска совпадений. Файл прикрепить не могу, а форма имеет вид:
WowGun, насколько я понял Ваш код привязан к событиям листа, а оно произойдот только после нажатия кнопки ввода, то есть по факту дублирующая запись может появиться. Я себе представляю себе так: при инициализации формы создается массив из данных трех столбцов, после вода трех ключевых параметров (договор+тепловоз+дата) в текстбоксы данные сравниваются с записями в массиве но обязательно построчно (это то, что у меня не получается) и если выполняется условие равенства трех записей (And) то выходим из процедуры (формы) с меседжем. Ввод всех внесенных на форму данных на лист выполняется одновременно, как и в файле-примере. Я только начал разбираться в цыклах и не знаю как организовать перебор массива по индексам столбцов в строках для поиска совпадений. Файл прикрепить не могу, а форма имеет вид:Shylo
а оно произойдот только после нажатия кнопки ввода, то есть по факту дублирующая запись может появиться
Я что-то запутался в правах ... Я прав - внесение в Ячейки, или вы правы - не внесение в ячейки?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Or Target.Column = 2 Or Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Then r = Target.row n1 = Range("B" & r) n2 = Range("C" & r) n3 = Range("D" & r) n4 = Range("E" & r) For I = 2 To r If Range("B" & I) = n1 And Range("C" & I) = n2 And Range("D" & I) = n3 And Range("E" & I) = n4 And I <> r Then Range(I & ":" & I).Select MsgBox ("Вводимая запись будет удалена, так как она дублируют данные в строке " & I) Rows(r).Delete End If Next End If End Sub
[/vba] Код реагирует на ВВЕДЕННЫЕ данные в ЯЧЕЙКИ и ЕСЛИ они дублированы, то УДАЛЯЕТ их. Если ваши эстетические чувства не позволяют вам идти этим путем - ваше дело. Эстетство никто не отменял. Я НЕ тестировал вашу форму ... В решении руководствовался минимализмом.
а оно произойдот только после нажатия кнопки ввода, то есть по факту дублирующая запись может появиться
Я что-то запутался в правах ... Я прав - внесение в Ячейки, или вы правы - не внесение в ячейки?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Or Target.Column = 2 Or Target.Column = 3 Or Target.Column = 4 Or Target.Column = 5 Then r = Target.row n1 = Range("B" & r) n2 = Range("C" & r) n3 = Range("D" & r) n4 = Range("E" & r) For I = 2 To r If Range("B" & I) = n1 And Range("C" & I) = n2 And Range("D" & I) = n3 And Range("E" & I) = n4 And I <> r Then Range(I & ":" & I).Select MsgBox ("Вводимая запись будет удалена, так как она дублируют данные в строке " & I) Rows(r).Delete End If Next End If End Sub
[/vba] Код реагирует на ВВЕДЕННЫЕ данные в ЯЧЕЙКИ и ЕСЛИ они дублированы, то УДАЛЯЕТ их. Если ваши эстетические чувства не позволяют вам идти этим путем - ваше дело. Эстетство никто не отменял. Я НЕ тестировал вашу форму ... В решении руководствовался минимализмом.WowGun
УЧИТЕСЬ ... спрашивать.
Сообщение отредактировал WowGun - Пятница, 21.06.2024, 21:00
WowGun, Большое спасибо за хороший пример, обязательно попробую применить в дальнейшем. Но в моем готовом файле этот подход портит все остальное. Я не специалист по VBA и наверно поэтому у меня возникают сложности для кого то очень простые. Еще раз спасибо, что уделили время.
WowGun, Большое спасибо за хороший пример, обязательно попробую применить в дальнейшем. Но в моем готовом файле этот подход портит все остальное. Я не специалист по VBA и наверно поэтому у меня возникают сложности для кого то очень простые. Еще раз спасибо, что уделили время.Shylo
Shylo, Доброго вам дня. Вам WowGun дал вариант как вы могли бы сделать но вы не поняли направление. Ну да и ладно. Вот вариант: [vba]
Код
Option Explicit
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("бд01") Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).row Dim found As Boolean: found = False Dim i_dog As String: i_dog = TextBox1.Text Dim i_tepl As String: i_tepl = TextBox2.Text Dim i_daty As String: i_daty = TextBox3.Text Dim i As Long
For i = 2 To lastRow
If ws.Cells(i, 3).Value = i_dog And ws.Cells(i, 4).Value = i_tepl And ws.Cells(i, 5).Value = i_daty Then found = True Exit For End If
Next i
If found Then MsgBox "Такая запись есть!"
TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox1.SetFocus End If
End Sub
[/vba] Вроде бы работает. Мира и Здоровья!
Shylo, Доброго вам дня. Вам WowGun дал вариант как вы могли бы сделать но вы не поняли направление. Ну да и ладно. Вот вариант: [vba]
Код
Option Explicit
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("бд01") Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).row Dim found As Boolean: found = False Dim i_dog As String: i_dog = TextBox1.Text Dim i_tepl As String: i_tepl = TextBox2.Text Dim i_daty As String: i_daty = TextBox3.Text Dim i As Long
For i = 2 To lastRow
If ws.Cells(i, 3).Value = i_dog And ws.Cells(i, 4).Value = i_tepl And ws.Cells(i, 5).Value = i_daty Then found = True Exit For End If
Next i
If found Then MsgBox "Такая запись есть!"
TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox1.SetFocus End If
MikeVol, Николай, благодарю. Красивое решение, которое применил Владимир, хорошо применимо при ручном заполнении полей таблицы, и не совсем подходило к моему подходу при заполнении через форму. В Вашем коде для меня изюминкой стала вот эта часть: [vba]
Код
If ws.Cells(i, 3).Value = i_dog And ws.Cells(i, 4).Value = i_tepl And ws.Cells(i, 5).Value = i_daty Then found = True Exit For
[/vba] до которой я сам не додумался. На рабочем файле при умышленном вводе одинаковой записи дубль не находило, оказалось, что в TextBox'е ввода даты на форме я применил сокращенный формат даты но в ячейку передавал через CDate. Т.е. в TextBox'е значится "01.01.24", а в ячейке "01.01.2024" в итоге found всегда False - разобрался и исправил. Но попробую свои силы еще чрез индексы поискать в массиве, суть уловил. Еще раз большое спасибо за помощь.
MikeVol, Николай, благодарю. Красивое решение, которое применил Владимир, хорошо применимо при ручном заполнении полей таблицы, и не совсем подходило к моему подходу при заполнении через форму. В Вашем коде для меня изюминкой стала вот эта часть: [vba]
Код
If ws.Cells(i, 3).Value = i_dog And ws.Cells(i, 4).Value = i_tepl And ws.Cells(i, 5).Value = i_daty Then found = True Exit For
[/vba] до которой я сам не додумался. На рабочем файле при умышленном вводе одинаковой записи дубль не находило, оказалось, что в TextBox'е ввода даты на форме я применил сокращенный формат даты но в ячейку передавал через CDate. Т.е. в TextBox'е значится "01.01.24", а в ячейке "01.01.2024" в итоге found всегда False - разобрался и исправил. Но попробую свои силы еще чрез индексы поискать в массиве, суть уловил. Еще раз большое спасибо за помощь. Shylo
Сообщение отредактировал Shylo - Четверг, 11.07.2024, 11:10
Shylo, Ещё как вариант можно использовать словари: [vba]
Код
Option Explicit
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("бд01") Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).row Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary") Dim i_dog As String: i_dog = TextBox1.Text Dim i_tepl As String: i_tepl = TextBox2.Text Dim i_daty As String: i_daty = TextBox3.Text Dim found As Boolean: found = False Dim i As Long
For i = 2 To lastRow Dim key As String: key = ws.Cells(i, 3).Value & "|" & ws.Cells(i, 4).Value & "|" & ws.Cells(i, 5).Value
If Not dict.exists(key) Then dict.Add key, i End If
Next i
key = i_dog & "|" & i_tepl & "|" & i_daty
If dict.exists(key) Then found = True End If
If found Then MsgBox "Такая запись есть!"
TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" End If
Set dict = Nothing Set ws = Nothing End Sub
[/vba] При большом количестве данных данный код с использованием словаря будет работать быстрее, чем оригинальный код из #8 поста. Мира и Здоровья!
Shylo, Ещё как вариант можно использовать словари: [vba]
Код
Option Explicit
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("бд01") Dim lastRow As Long: lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).row Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary") Dim i_dog As String: i_dog = TextBox1.Text Dim i_tepl As String: i_tepl = TextBox2.Text Dim i_daty As String: i_daty = TextBox3.Text Dim found As Boolean: found = False Dim i As Long
For i = 2 To lastRow Dim key As String: key = ws.Cells(i, 3).Value & "|" & ws.Cells(i, 4).Value & "|" & ws.Cells(i, 5).Value
If Not dict.exists(key) Then dict.Add key, i End If
Next i
key = i_dog & "|" & i_tepl & "|" & i_daty
If dict.exists(key) Then found = True End If
If found Then MsgBox "Такая запись есть!"
TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" End If
Set dict = Nothing Set ws = Nothing End Sub
[/vba] При большом количестве данных данный код с использованием словаря будет работать быстрее, чем оригинальный код из #8 поста. Мира и Здоровья!MikeVol
При большом количестве данных словарь можно сделать публичным, и заполнять его ОДИН раз например при открытии формы (или файла), и через массив, а не циклом по ячейкам. И будет вообще пулей всё летать и на миллион записей. P.S. посмотрел файл - там на миллионе зависнет при открытии формы, и таких объёмов очевидно не ожидается. Но всё равно я бы ускорил заполняя листбокс используя массив с листа, и тут же можно и словарь заполнить, тем более что данные уже в массиве. P.S. приложил файл, там есть ещё что покрутить, но схема работает.
При большом количестве данных словарь можно сделать публичным, и заполнять его ОДИН раз например при открытии формы (или файла), и через массив, а не циклом по ячейкам. И будет вообще пулей всё летать и на миллион записей. P.S. посмотрел файл - там на миллионе зависнет при открытии формы, и таких объёмов очевидно не ожидается. Но всё равно я бы ускорил заполняя листбокс используя массив с листа, и тут же можно и словарь заполнить, тем более что данные уже в массиве. P.S. приложил файл, там есть ещё что покрутить, но схема работает.Hugo
Hugo, Приветствую вас! Я не всматривался в весь код формы. Примитивный вариант и сделал я. Ваш вариант несомненно лучше, тут и спорить не стоит. Удачи!
Hugo, Приветствую вас! Я не всматривался в весь код формы. Примитивный вариант и сделал я. Ваш вариант несомненно лучше, тут и спорить не стоит. Удачи!MikeVol
- это просто разделитель значений. Конкретно в этом случае можно обойтись и без него, но привычка )) Представьте что у вас в данных три столбца с значениями 123 4 56 12 34 56 1 23 456 Если при создании ключа словаря не использовать разделитель - у всех будет одинаковый ключ, а это ведь разные строки. И разные Конторы.
- это просто разделитель значений. Конкретно в этом случае можно обойтись и без него, но привычка )) Представьте что у вас в данных три столбца с значениями 123 4 56 12 34 56 1 23 456 Если при создании ключа словаря не использовать разделитель - у всех будет одинаковый ключ, а это ведь разные строки. И разные Конторы.Hugo
Hugo, В процессе применения к своему рабочему файлу Вашего примера, попытался исправить диапазон формирования словаря, подскажите как исправить код чтобы словарь формировался начиная с третьей строки (выше шапка) и только столбцы "В:Е" до последней заполненной строки.
Hugo, В процессе применения к своему рабочему файлу Вашего примера, попытался исправить диапазон формирования словаря, подскажите как исправить код чтобы словарь формировался начиная с третьей строки (выше шапка) и только столбцы "В:Е" до последней заполненной строки.Shylo
Смотрим код: a = [a1].CurrentRegion.Value тут берём в массив все смежные с A1 данные, как в прказанном примере For i = 1 To UBound(a) тут перебираем данные с первой строки. С заголовками, что может и лишнее было.
Что там у Вас теперь в файле знаете только Вы - может достаточно с третьей строки перебирать, а может массив вообще нужно иначе формировать, может там снизу лишнее будет, или с боков что прилипнет... Файл нужно видеть, и задачу.
Смотрим код: a = [a1].CurrentRegion.Value тут берём в массив все смежные с A1 данные, как в прказанном примере For i = 1 To UBound(a) тут перебираем данные с первой строки. С заголовками, что может и лишнее было.
Что там у Вас теперь в файле знаете только Вы - может достаточно с третьей строки перебирать, а может массив вообще нужно иначе формировать, может там снизу лишнее будет, или с боков что прилипнет... Файл нужно видеть, и задачу.Hugo
Hugo, Тоже так понял, но изменив [а1] на [В2] и For i=2 в Вашем файле примере, в окошке Locals переменная "а" все равно содержит шапку таблицы.
В моей рабочей таблице нет пустых строк и пустых столбцов, и я так понимаю, через CurrentRegion будет считывается весь лист, а это до 3 тыс. строк и 18 столбцов, что явный избыток по столбцам. Я в своих потугах создания массива формировал его с третей строки (без шапки) и только четыре значащих столбца "В:Е". Буду благодарен если подскажите как это сделать со словарем.
Hugo, Тоже так понял, но изменив [а1] на [В2] и For i=2 в Вашем файле примере, в окошке Locals переменная "а" все равно содержит шапку таблицы.
В моей рабочей таблице нет пустых строк и пустых столбцов, и я так понимаю, через CurrentRegion будет считывается весь лист, а это до 3 тыс. строк и 18 столбцов, что явный избыток по столбцам. Я в своих потугах создания массива формировал его с третей строки (без шапки) и только четыре значащих столбца "В:Е". Буду благодарен если подскажите как это сделать со словарем.Shylo
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
