Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Контроль дублирующеся (существующей) записти в таблице - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Контроль дублирующеся (существующей) записти в таблице
Shylo Дата: Пятница, 21.06.2024, 15:20 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 161
Репутация: 7 ±
Замечаний: 0% ±

Excel-2003; 2010
Приветствую всех. Сделал таблицу в которую сотрудники периодически вносят данные по инспектированию через форму пользователя. Но бывают ситуации когда данные поступают с опозданием или из разных источников и в таблицу могут попасть записи уже внесённые данные. У меня не получается организовать контроль наличия записи на этапе ввода данных. Контроль достаточно организовать по № договора, марке тепловоза и дате проведения инспектирования. Если эти три параметра, взятые из одной строки, совпадают то ввод остальной информации надо прервать и проинформировать оператора, что такая запись уже есть. У меня (на этапе моделирования) получилось загнать контролируемые данные из таблицы (три столбца) в массив, при вводе в ТексБоксы контролировать их наличие перебором значений массива, но не получается их соотнести только к одной строке. Например, сочетание 015-24+ТГМ4-0169+15.01.24 должно быть уникальным (из-за даты) и повторный ввод с таким сочетанием необходимо прервать. Возможно, я выбрал не правильный подход к решению этой задачи, хотя искал и пробывал несколько методов, заходя в тупик. Буду благодарен за помощь. Файл примера прилагаю.
К сообщению приложен файл: obrazec_df.xlsm (32.8 Kb)
 
Ответить
СообщениеПриветствую всех. Сделал таблицу в которую сотрудники периодически вносят данные по инспектированию через форму пользователя. Но бывают ситуации когда данные поступают с опозданием или из разных источников и в таблицу могут попасть записи уже внесённые данные. У меня не получается организовать контроль наличия записи на этапе ввода данных. Контроль достаточно организовать по № договора, марке тепловоза и дате проведения инспектирования. Если эти три параметра, взятые из одной строки, совпадают то ввод остальной информации надо прервать и проинформировать оператора, что такая запись уже есть. У меня (на этапе моделирования) получилось загнать контролируемые данные из таблицы (три столбца) в массив, при вводе в ТексБоксы контролировать их наличие перебором значений массива, но не получается их соотнести только к одной строке. Например, сочетание 015-24+ТГМ4-0169+15.01.24 должно быть уникальным (из-за даты) и повторный ввод с таким сочетанием необходимо прервать. Возможно, я выбрал не правильный подход к решению этой задачи, хотя искал и пробывал несколько методов, заходя в тупик. Буду благодарен за помощь. Файл примера прилагаю.

Автор - Shylo
Дата добавления - 21.06.2024 в 15:20
WowGun Дата: Пятница, 21.06.2024, 16:33 | Сообщение № 2
Группа: Проверенные
Ранг: Новичок
Сообщений: 37
Репутация: 10 ±
Замечаний: 0% ±

Excel 2016
Добрый день.
Возможно будет проще проконтролировать совпадения не на этапе ввода в форму, а на этапе внесения в ячейки. Минус для тех, кто вносит ... но для организации проверки может стать плюсом.


УЧИТЕСЬ ... спрашивать.
 
Ответить
СообщениеДобрый день.
Возможно будет проще проконтролировать совпадения не на этапе ввода в форму, а на этапе внесения в ячейки. Минус для тех, кто вносит ... но для организации проверки может стать плюсом.

Автор - WowGun
Дата добавления - 21.06.2024 в 16:33
Shylo Дата: Пятница, 21.06.2024, 16:46 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 161
Репутация: 7 ±
Замечаний: 0% ±

Excel-2003; 2010
Добрый день. Вы праваы. Так именно на этапе ввода я и хочу реализовать. Файл с примером это как черновик для отработки. Т.е. в процессе вводе через форму при заполнении соответствующих текстбоксов и по процедуре выхода из TextBox3 выполняется алгоритм проверки с принятием соответственного решения.
 
Ответить
СообщениеДобрый день. Вы праваы. Так именно на этапе ввода я и хочу реализовать. Файл с примером это как черновик для отработки. Т.е. в процессе вводе через форму при заполнении соответствующих текстбоксов и по процедуре выхода из TextBox3 выполняется алгоритм проверки с принятием соответственного решения.

Автор - Shylo
Дата добавления - 21.06.2024 в 16:46
WowGun Дата: Пятница, 21.06.2024, 17:58 | Сообщение № 4
Группа: Проверенные
Ранг: Новичок
Сообщений: 37
Репутация: 10 ±
Замечаний: 0% ±

Excel 2016
Так и попробуйте прикрутить 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 - Пятница, 21.06.2024, 19:35
 
Ответить
СообщениеТак и попробуйте прикрутить 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
Дата добавления - 21.06.2024 в 17:58
Shylo Дата: Пятница, 21.06.2024, 20:34 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 161
Репутация: 7 ±
Замечаний: 0% ±

Excel-2003; 2010
WowGun, насколько я понял Ваш код привязан к событиям листа, а оно произойдот только после нажатия кнопки ввода, то есть по факту дублирующая запись может появиться. Я себе представляю себе так: при инициализации формы создается массив из данных трех столбцов, после вода трех ключевых параметров (договор+тепловоз+дата) в текстбоксы данные сравниваются с записями в массиве но обязательно построчно (это то, что у меня не получается) и если выполняется условие равенства трех записей (And) то выходим из процедуры (формы) с меседжем. Ввод всех внесенных на форму данных на лист выполняется одновременно, как и в файле-примере. Я только начал разбираться в цыклах и не знаю как организовать перебор массива по индексам столбцов в строках для поиска совпадений. Файл прикрепить не могу, а форма имеет вид:
К сообщению приложен файл: 3908123.jpg (29.5 Kb)
 
Ответить
СообщениеWowGun, насколько я понял Ваш код привязан к событиям листа, а оно произойдот только после нажатия кнопки ввода, то есть по факту дублирующая запись может появиться. Я себе представляю себе так: при инициализации формы создается массив из данных трех столбцов, после вода трех ключевых параметров (договор+тепловоз+дата) в текстбоксы данные сравниваются с записями в массиве но обязательно построчно (это то, что у меня не получается) и если выполняется условие равенства трех записей (And) то выходим из процедуры (формы) с меседжем. Ввод всех внесенных на форму данных на лист выполняется одновременно, как и в файле-примере. Я только начал разбираться в цыклах и не знаю как организовать перебор массива по индексам столбцов в строках для поиска совпадений. Файл прикрепить не могу, а форма имеет вид:

Автор - Shylo
Дата добавления - 21.06.2024 в 20:34
WowGun Дата: Пятница, 21.06.2024, 20:59 | Сообщение № 6
Группа: Проверенные
Ранг: Новичок
Сообщений: 37
Репутация: 10 ±
Замечаний: 0% ±

Excel 2016
Возможно будет проще проконтролировать совпадения не на этапе ввода в форму, а на этапе внесения в ячейки


Вы праваы


а оно произойдот только после нажатия кнопки ввода, то есть по факту дублирующая запись может появиться

Я что-то запутался в правах ... :)
Я прав - внесение в Ячейки, или вы правы - не внесение в ячейки? :)

[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 - Пятница, 21.06.2024, 21:00
 
Ответить
Сообщение
Возможно будет проще проконтролировать совпадения не на этапе ввода в форму, а на этапе внесения в ячейки


Вы праваы


а оно произойдот только после нажатия кнопки ввода, то есть по факту дублирующая запись может появиться

Я что-то запутался в правах ... :)
Я прав - внесение в Ячейки, или вы правы - не внесение в ячейки? :)

[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
Дата добавления - 21.06.2024 в 20:59
Shylo Дата: Понедельник, 24.06.2024, 07:53 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 161
Репутация: 7 ±
Замечаний: 0% ±

Excel-2003; 2010
WowGun, Большое спасибо за хороший пример, обязательно попробую применить в дальнейшем. Но в моем готовом файле этот подход портит все остальное. Я не специалист по VBA и наверно поэтому у меня возникают сложности для кого то очень простые. Еще раз спасибо, что уделили время.
 
Ответить
СообщениеWowGun, Большое спасибо за хороший пример, обязательно попробую применить в дальнейшем. Но в моем готовом файле этот подход портит все остальное. Я не специалист по VBA и наверно поэтому у меня возникают сложности для кого то очень простые. Еще раз спасибо, что уделили время.

Автор - Shylo
Дата добавления - 24.06.2024 в 07:53
MikeVol Дата: Вторник, 09.07.2024, 12:04 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 318
Репутация: 64 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
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

End Sub
[/vba] Вроде бы работает. Мира и Здоровья!

Автор - MikeVol
Дата добавления - 09.07.2024 в 12:04
Shylo Дата: Среда, 10.07.2024, 16:08 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 161
Репутация: 7 ±
Замечаний: 0% ±

Excel-2003; 2010
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 - разобрался и исправил. Но попробую свои силы еще чрез индексы поискать в массиве, суть уловил.
Еще раз большое спасибо за помощь. hands


Сообщение отредактировал Shylo - Четверг, 11.07.2024, 11:10
 
Ответить
Сообщение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 - разобрался и исправил. Но попробую свои силы еще чрез индексы поискать в массиве, суть уловил.
Еще раз большое спасибо за помощь. hands

Автор - Shylo
Дата добавления - 10.07.2024 в 16:08
MikeVol Дата: Пятница, 12.07.2024, 10:24 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 318
Репутация: 64 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
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
Дата добавления - 12.07.2024 в 10:24
Hugo Дата: Пятница, 12.07.2024, 10:45 | Сообщение № 11
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3370
Репутация: 722 ±
Замечаний: 0% ±

2019
При большом количестве данных словарь можно сделать публичным, и заполнять его ОДИН раз например при открытии формы (или файла), и через массив, а не циклом по ячейкам.
И будет вообще пулей всё летать и на миллион записей.
P.S. посмотрел файл - там на миллионе зависнет при открытии формы, и таких объёмов очевидно не ожидается.
Но всё равно я бы ускорил заполняя листбокс используя массив с листа, и тут же можно и словарь заполнить, тем более что данные уже в массиве.
P.S. приложил файл, там есть ещё что покрутить, но схема работает.
К сообщению приложен файл: obrazec_df_dictionary.xlsm (34.7 Kb)


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Пятница, 12.07.2024, 12:21
 
Ответить
СообщениеПри большом количестве данных словарь можно сделать публичным, и заполнять его ОДИН раз например при открытии формы (или файла), и через массив, а не циклом по ячейкам.
И будет вообще пулей всё летать и на миллион записей.
P.S. посмотрел файл - там на миллионе зависнет при открытии формы, и таких объёмов очевидно не ожидается.
Но всё равно я бы ускорил заполняя листбокс используя массив с листа, и тут же можно и словарь заполнить, тем более что данные уже в массиве.
P.S. приложил файл, там есть ещё что покрутить, но схема работает.

Автор - Hugo
Дата добавления - 12.07.2024 в 10:45
MikeVol Дата: Пятница, 12.07.2024, 18:40 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 318
Репутация: 64 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Hugo, Приветствую вас! Я не всматривался в весь код формы. Примитивный вариант и сделал я. Ваш вариант несомненно лучше, тут и спорить не стоит. Удачи!


Ученик.
 
Ответить
СообщениеHugo, Приветствую вас! Я не всматривался в весь код формы. Примитивный вариант и сделал я. Ваш вариант несомненно лучше, тут и спорить не стоит. Удачи!

Автор - MikeVol
Дата добавления - 12.07.2024 в 18:40
Hugo Дата: Пятница, 12.07.2024, 18:57 | Сообщение № 13
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3370
Репутация: 722 ±
Замечаний: 0% ±

2019
MikeVol, приветствую.
Я и без претензий, просто если можно ускорить - ускоряю.
Тоже код не вычитывал, решал только что спросили.


excel@nxt.ru
webmoney: E265281470651 Z422237915069
 
Ответить
СообщениеMikeVol, приветствую.
Я и без претензий, просто если можно ускорить - ускоряю.
Тоже код не вычитывал, решал только что спросили.

Автор - Hugo
Дата добавления - 12.07.2024 в 18:57
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!