Excel - zamezení vložení duplicitních dat Vyřešeno
Excel - zamezení vložení duplicitních dat
Vkládám data do databáze v excelu pomocí useformu s textboxsem (jména, příjmení, datum narození). Potřeboval bych, aby pokud při vložení budou zjištěna stejná data jsem mohl např. msboxem potvrdit, nebo zrušit vložení do tabulky.
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Excel - zamezení vložení duplicitních dat
Obecna odpoved je, ze lze a to pomoci procedury VBA, ktera prohleda databazi. V udalostni procedure reagujici na stisk vkladaciho tlacitka prohledat data v tabulce, v pripade duplicity msgbox, jinak data ulozit.
Pro konkretni reseni priloz vzorovy soubor obsahujici formular a tabulku vcetne jiz napsanych prislusnych procedur. Zaroven uved "rozsah " duplicity, zda cely zaznam (vsechny polozky) nebo jen nektere.
Je potreba pocitat s tim, ze se zvetsujicim se poctem zaznamu v databazi bude narustat doba potrebna k overeni.
Pro konkretni reseni priloz vzorovy soubor obsahujici formular a tabulku vcetne jiz napsanych prislusnych procedur. Zaroven uved "rozsah " duplicity, zda cely zaznam (vsechny polozky) nebo jen nektere.
Je potreba pocitat s tim, ze se zvetsujicim se poctem zaznamu v databazi bude narustat doba potrebna k overeni.
Re: Excel - zamezení vložení duplicitních dat
Vlastní databáze bude mít okolo 500 položek a napadlo mě, že by šlo data vložit, pak zjistit, že se data ve všech třech sloupcích neshoduji -akce nic - shodují - vyžádat potvrzení msboxem k pokračování (nechání dat), nebo "nevložení" smazání posledního vloženého řádku. Přikládám soubor.
- Přílohy
-
- Data.xlsm
- (25.45 KiB) Staženo 42 x
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Excel - zamezení vložení duplicitních dat
V editoru VBA vloz do modulu UserForm1 tyto upravene procedury (oprav si diakritiku):
Do bunky list1!A3 vloz vzorec (puvodni vzorec je zbytecne slozity): =KDYŽ(B3="";"";A2+1) a kopiruj dolu dle potreby. Tlaciko na listu2 pouzij z Ovladacich prvku nikoliv z Formulare. U nazvu ovladacich prvku se rid podle: http://www.officir.ic.cz/chipex05/07/ex ... _form.html ,je to prehlednejsi a lepe se orientuje ve slozitejsim formulari.
Kód: Vybrat vše
Option Explicit
Private Sub CommandButton1_Click()
Dim TBlk As Range, TCll As Range
Dim firstAddress As String
If TextBox1.Value = "" Then
MsgBox "Vyplòte prosím pole jméno"
TextBox1.SetFocus
Exit Sub
End If
If TextBox2.Value = "" Then
MsgBox "Vyplòte prosím pole pøíjmení"
TextBox2.SetFocus
Exit Sub
End If
If TextBox3.Value = "" Then
MsgBox "Vyplòte prosím pole datum narození"
TextBox3.SetFocus
Exit Sub
End If
If Not IsDate(TextBox3.Value) Then
MsgBox "Vyplňte prosím správně pole datum narození"
TextBox3 = vbNullString
TextBox3.SetFocus
Exit Sub
End If
' blok dat na list1!B:B
With Worksheets("list1")
Set TBlk = .Range(.Range("b1"), .Range("b1").End(xlDown))
End With
' prohledat blok
With TBlk
Set TCll = .Find(TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole) ' sloupec B:B
If Not TCll Is Nothing Then
firstAddress = TCll.Address
Do
If TextBox2.Value = TCll.Offset(0, 1).Value Then ' sloupec C:C
If DateValue(TextBox3.Value) = DateValue(TCll.Offset(0, 2).Value) Then ' sloupec D:D
MsgBox "Duplicitni zaznam": GoTo ErrHandler
End If
End If
Set TCll = .FindNext(TCll)
Loop While Not TCll Is Nothing And TCll.Address <> firstAddress
End If
End With
' cilova bunka pro vlozeni dat
Set TCll = TBlk.Resize(1, 1).Offset(TBlk.Rows.Count, 0)
' vlozit data
TCll.Value = TextBox1.Value
TCll.Offset(0, 1).Value = TextBox2.Value
TCll.Offset(0, 2).Value = TextBox3.Value
' vyprazdnit textboxy
TextBox1.Text = vbNullString
TextBox2.Text = vbNullString
TextBox3.Text = vbNullString
ErrHandler:
Set TCll = Nothing
Set TBlk = Nothing
End Sub
Private Sub CommandButton2_Click()
' vyprazdnit textboxy
TextBox1.Text = vbNullString
TextBox2.Text = vbNullString
TextBox3.Text = vbNullString
UserForm1.Hide
End Sub
Do bunky list1!A3 vloz vzorec (puvodni vzorec je zbytecne slozity): =KDYŽ(B3="";"";A2+1) a kopiruj dolu dle potreby. Tlaciko na listu2 pouzij z Ovladacich prvku nikoliv z Formulare. U nazvu ovladacich prvku se rid podle: http://www.officir.ic.cz/chipex05/07/ex ... _form.html ,je to prehlednejsi a lepe se orientuje ve slozitejsim formulari.
Re: Excel - zamezení vložení duplicitních dat
Funguje to skvěle, pouze se zeptám je možnost, aby se při duplicitních záznamech zeptal a já se mohl rozhodnout zda je přesto nevložit a dále jak nastavit kurzor pro psaní do textbox1.
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Excel - zamezení vložení duplicitních dat Vyřešeno
Pro zobrazeni kurzoru pri inicializaci pouzij proceduru:
Pro moznost vlozeni duplicitniho zaznamu vloz do UserForm1 CheckBox:
Name: chkVloz - odkazuji procedury
Caption: Vlozit duplicitni zaznam
Dale ve formulari zrus Frame pro textboxy a pro nadepsani pouzij Label.
Ve formulari usporadej poradi presunu fokusu pro Tab: aktivni navrh formulare>nabidka View>TabOrder>usporadej TextBox1, TextBox2,.. tlacitka, chkVloz >OK
Upravene procedury:
Kód: Vybrat vše
Sub tlačítko1_Klepnutí()
With UserForm1
.Show vbModeless
.TextBox1.SetFocus
End With
End Sub
Pro moznost vlozeni duplicitniho zaznamu vloz do UserForm1 CheckBox:
Name: chkVloz - odkazuji procedury
Caption: Vlozit duplicitni zaznam
Dale ve formulari zrus Frame pro textboxy a pro nadepsani pouzij Label.
Ve formulari usporadej poradi presunu fokusu pro Tab: aktivni navrh formulare>nabidka View>TabOrder>usporadej TextBox1, TextBox2,.. tlacitka, chkVloz >OK
Upravene procedury:
Kód: Vybrat vše
Option Explicit
Private Sub CommandButton1_Click()
Dim TBlk As Range, TCll As Range
Dim firstAddress As String
If TextBox1.Value = "" Then
MsgBox "Vyplòte prosím pole jméno"
TextBox1.SetFocus
Exit Sub
End If
If TextBox2.Value = "" Then
MsgBox "Vyplòte prosím pole pøíjmení"
TextBox2.SetFocus
Exit Sub
End If
If TextBox3.Value = "" Then
MsgBox "Vyplòte prosím pole datum narození"
TextBox3.SetFocus
Exit Sub
End If
If Not IsDate(TextBox3.Value) Then
MsgBox "Vyplòte prosím správnì pole datum narození"
TextBox3 = vbNullString
TextBox3.SetFocus
Exit Sub
End If
' blok dat na list1!B:B
With Worksheets("list1")
Set TBlk = .Range(.Range("b1"), .Range("b1").End(xlDown))
End With
If Not chkVloz Then ' vlozit neduplicitni zaznam
' prohledat blok
With TBlk
Set TCll = .Find(TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole) ' sloupec B:B
If Not TCll Is Nothing Then
firstAddress = TCll.Address
Do
If TextBox2.Value = TCll.Offset(0, 1).Value Then ' sloupec C:C
If DateValue(TextBox3.Value) = DateValue(TCll.Offset(0, 2).Value) Then ' sloupec D:D
MsgBox "Duplicitni zaznam": GoTo ErrHandler
End If
End If
Set TCll = .FindNext(TCll)
Loop While Not TCll Is Nothing And TCll.Address <> firstAddress
End If
End With
End If
' cilova bunka pro vlozeni dat
Set TCll = TBlk.Resize(1, 1).Offset(TBlk.Rows.Count, 0)
' vlozit data
TCll.Value = TextBox1.Value
TCll.Offset(0, 1).Value = TextBox2.Value
TCll.Offset(0, 2).Value = TextBox3.Value
' vyprazdnit textboxy
TextBox1.Text = vbNullString
TextBox2.Text = vbNullString
TextBox3.Text = vbNullString
chkVloz.Value = False
TextBox1.SetFocus
ErrHandler:
Set TCll = Nothing
Set TBlk = Nothing
End Sub
Private Sub CommandButton2_Click()
' vyprazdnit textboxy
TextBox1.Text = vbNullString
TextBox2.Text = vbNullString
TextBox3.Text = vbNullString
chkVloz.Value = False
UserForm1.Hide
End Sub
- Přílohy
-
- PNData.xls
- (73 KiB) Staženo 49 x
Re: Excel - zamezení vložení duplicitních dat
Děkuji, funguje tak jak jsem potřeboval.No mám se co učit.
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 0
- 1153
-
od Zabral68
Zobrazit poslední příspěvek
28 čer 2023 19:06
-
- 16
- 6327
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
-
- 2
- 1835
-
od honzzicek
Zobrazit poslední příspěvek
01 črc 2023 08:57
-
- 5
- 2578
-
od mmmartin
Zobrazit poslední příspěvek
13 črc 2023 18:44
-
-
Excel komparacedvou soborů Příloha(y)
od teichmann.ondrej » 15 dub 2024 17:26 » v Kancelářské balíky - 11
- 3403
-
od teichmann.ondrej
Zobrazit poslední příspěvek
22 dub 2024 15:45
-
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti