Makro weryfikujące duplikaty

1

Cześć,
mam napisane makro, które na zasadzie uzupełniania formularza przez użytkownika przenosi informację do bazy danych.
Potrzebuję dopisać kod, który będzie weryfikował, czy wprowadzane dane nie są duplikowane.

Tzn. jest jeden parametr (w Arkuszu3 (U23:U5000), który jest unikalny - działa na zasadzie funkcji "ZŁĄCZ.TEKSTY" z kolumny P i Q (=ZŁĄCZ.TEKSTY(P23;Q23).
Chciałbym by makro sprawdzało, czy w tym ciągu (U23:U5000) nie występuję już wartość, którą użytkownik próbuję zarejestrować z komórki "P11" i "P13".
Jeżeli wartość się duplikuję, chciałbym aby wyskoczył MsqBox z informacją o duplikacie i by wpisane dane nie zostały wprowadzone do bazy danych.

Poniżej aktualny kod:

Sub REJSTRACJA()
Dim ileW As Integer
ileW = Arkusz3.Range("M22").Value
Arkusz3.Range("N" & ileW + 23).Value = Arkusz3.Range("P7").Value
Arkusz3.Range("O" & ileW + 23).Value = Arkusz3.Range("P9").Value
Arkusz3.Range("P" & ileW + 23).Value = Arkusz3.Range("P11").Value
Arkusz3.Range("Q" & ileW + 23).Value = Arkusz3.Range("P13").Value
Arkusz3.Range("R" & ileW + 23).Value = Arkusz3.Range("P15").Value

MsgBox "Dane wprowadzone!", vbExclamation + vbOKOnly, "Informacja"

Call wyczyść
Call przenieś2

End Sub

Pomoże ktoś ogarnąć ten temat?

0

gpt daje coś takiego, wygląda ok

    duplicateFound = False
    For Each cell In Arkusz3.Range("U23:U5000")
        If cell.Value = newValue Then
            duplicateFound = True
            Exit For
        End If
    Next cell

możesz też włączyć walidację danych w skoroszycie, wtedy nie będzie można wprowadzić duplikatów również ręcznie
https://www.excel-easy.com/examples/prevent-duplicate-entries.html

0
Adam Siwirski napisał(a):

Cześć,
mam napisane makro, które na zasadzie uzupełniania formularza przez użytkownika przenosi informację do bazy danych.

Potrzebuję dopisać kod, który będzie weryfikował, czy wprowadzane dane nie są duplikowane.

Tzn. jest jeden parametr (w Arkuszu3 (U23:U5000), który jest unikalny - działa na zasadzie funkcji "ZŁĄCZ.TEKSTY" z kolumny P i Q (=ZŁĄCZ.TEKSTY(P23;Q23).
Chciałbym by makro sprawdzało, czy w tym ciągu (U23:U5000) nie występuję już wartość, którą użytkownik próbuję zarejestrować z komórki "P11" i "P13".
Jeżeli wartość się duplikuję, chciałbym aby wyskoczył MsqBox z informacją o duplikacie i by wpisane dane nie zostały wprowadzone do bazy danych.

Poniżej aktualny kod:

Sub REJSTRACJA()
Dim ileW As Integer
ileW = Arkusz3.Range("M22").Value
Arkusz3.Range("N" & ileW + 23).Value = Arkusz3.Range("P7").Value
Arkusz3.Range("O" & ileW + 23).Value = Arkusz3.Range("P9").Value
Arkusz3.Range("P" & ileW + 23).Value = Arkusz3.Range("P11").Value
Arkusz3.Range("Q" & ileW + 23).Value = Arkusz3.Range("P13").Value
Arkusz3.Range("R" & ileW + 23).Value = Arkusz3.Range("P15").Value

MsgBox "Dane wprowadzone!", vbExclamation + vbOKOnly, "Informacja"

Call wyczyść
Call przenieś2

End Sub

Pomoże ktoś ogarnąć ten temat?

Tak próuję zrobumieć- Twoje makro robi coś w styulu transpozycji. Tylko patrząc na opis i kod, to tu nie ma możliwości zduplikowania wartości.w kolumnie U.
np. P11 = AAA
P13 = AAA
P11 i P13 występują tutaj tylko raz. P11 ląduje w P23 (+ile wierszy) a P13 ląduje w Q23 (+ile wierszy)
finalnie w U23 powinno się pojawić AAAAAA (złącz teksty P23 i Q23). I po jednym wykonaniu tej procedury nigdy duplikat nie powinien się pojawić.

Albo czegoś nie rozumiem, albo opisałeś fragment większego, bardziej złożonego procesu.

0
Sub REJSTRACJA()
Dim ileW As Integer
ileW = Arkusz3.Range("M22").Value

a = Arkusz3.Range("P11").Value & Arkusz3.Range("P13").Value
lastrow = Arkusz3.Cells.Cells(Arkusz3.Rows.Count, "U").End(xlUp).Row

For i = 23 To lastrow

If Cells(i, "U").Value = a Then
MsgBox ("sa duplikaty, wychodzimy z procedury bye")
Exit Sub
End If

Next i

MsgBox ("wygląda na to, że duplikatow nie ma")

Arkusz3.Range("N" & ileW + 23).Value = Arkusz3.Range("P7").Value
Arkusz3.Range("O" & ileW + 23).Value = Arkusz3.Range("P9").Value
Arkusz3.Range("P" & ileW + 23).Value = Arkusz3.Range("P11").Value
Arkusz3.Range("Q" & ileW + 23).Value = Arkusz3.Range("P13").Value
Arkusz3.Range("R" & ileW + 23).Value = Arkusz3.Range("P15").Value

' kolumnę U można tutaj wypełnić (wartością) zamiast robić funkcję w arkuszu
Arkusz3.Range("U" & ileW + 23).Value = Arkusz3.Range("P" & ileW + 23).Value & Arkusz3.Range("Q" & ileW + 23).Value

MsgBox "Dane wprowadzone!", vbExclamation + vbOKOnly, "Informacja"
' po zapisaniu kolejnego rekordu można dodać do M22 wartość zwiekszoną o 1, bo chyba tam też coś musi zliczać rekordy
Arkusz3.Range("M22").Value = Arkusz3.Range("M22").Value + 1


Call wyczyść
Call przenieś2

End Sub

U mnie zadziałało, zmiany niewielkie.
Pętla to nie jest super rozwiązania, ale działa. Żeby to przyśpieszyć pewnie możnaby skorzystać z tablicy (ale więszka tablica pewnie potrzebowałaby trochę zasobów RAM).

Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.