[Excel] Cerca record con Userform.

[Robybike]

Salve, vi spiego il mio problema:
Ho un userform per creare un database, dove posso inserire, modificare, cancellare, scorrere e cercare i record.
Il mio problema sta nella ricerca dei record, posso farla sia per nome sia per n° pettorale, quando vado a fare la ricerca per pettorale tutto funziona bene utilizzando il codice sotto.

Codice: Seleziona tutto

Private Sub CommandButton8_Click()
If TextBox8 = "" Then
MsgBox "Inserisci N°Pettorale"
TextBox8.SetFocus
Exit Sub
End If
If OptionButton3.Value = True Then
secondo
End If

If OptionButton4.Value = True Then
With ActiveSheet.Range("A3:A150")
Dim x As String
x = TextBox8.Value
Set C = .Find(x, LookIn:=xlValues) ', LookAt:=xlWhole
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Cells.Select
TextBox2 = C.Value
TextBox3 = C.Offset(0, 1).Value
TextBox4 = C.Offset(0, 2).Value
TextBox5 = C.Offset(0, 3).Value

Y = C.Value
irisposta = MsgBox("Trovato " & Y & " . Vuoi fermarti ?", vbYesNo)
If irisposta = vbYes Then 'se rispondo si allora
GoTo 10 'esco dal ciclo
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress

Else
MsgBox "Nome non Trovato"
End If
10:
End With
End If
End Sub


Mentre quando vado a fare la ricerca per nome, m’inserisce tutti i dati tranne il numero pettorale

Codice: Seleziona tutto

Private Sub CommandButton1_Click()
If TextBox1 = "" Then
MsgBox "Inserisci Nome "
TextBox1.SetFocus
Exit Sub
End If
If OptionButton1.Value = True Then
primo
End If

If OptionButton2.Value = True Then
With ActiveSheet.Range("B3:B150")
Dim x As String
x = TextBox1.Value
Set C = .Find(x, LookIn:=xlValues) ', LookAt:=xlWhole
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.Cells.Select
TextBox2 = C.Offset(0, 0).Value
TextBox3 = C.Value
TextBox4 = C.Offset(0, 1).Value
TextBox5 = C.Offset(0, 2).Value

Y = C.Value
irisposta = MsgBox("Trovato " & Y & " . Vuoi fermarti ?", vbYesNo)
If irisposta = vbYes Then 'se rispondo si allora
GoTo 10 'esco dal ciclo
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> firstAddress

Else
MsgBox "Nome non Trovato"
End If
10:
End With
End If
End Sub


Inoltre quando vado a fare la ricerca facendo scorrere i record, dovrebbe bloccarsi sia all’inizio sia alla fine dei record, sia nella lista n°Pettorale sia in quella Nominativo.

Codice: Seleziona tutto

Private Sub CommandButton5_Click()
If ActiveCell.Offset(-1, 0).Value = "N°Pettorale" Then
MsgBox "Siamo a inizio elenco, impossibile salire oltre"
Exit Sub
End If

ActiveCell.Offset(-1, 0).Select
TextBox2 = ActiveCell.Offset(0, 0).Value
TextBox3 = ActiveCell.Offset(0, 1).Value
TextBox4 = ActiveCell.Offset(0, 2).Value
TextBox5 = ActiveCell.Offset(0, 3).Value


Allego il file excel per visionarlo.

http://freefilehosting.net/?id=rdnzkqrd8A==

Grazie

[Alexsandra]

Fai queste modifiche

Codice: Seleziona tutto

TextBox2 = C.Offset(0, -1).Value

sei già nella colonna 2, devi leggere la colonna A e la stessa modifica la devi fare nella sub primo

Codice: Seleziona tutto

riga = ActiveCell.Row
If riga = 3 Then
MsgBox "Siamo a inizio elenco, impossibile salire oltre"
Exit Sub
End If

sostituisci il tuo codice con questo invariato quello che segue
Ho aggiunto anche questo

Codice: Seleziona tutto

Private Sub UserForm_Activate()
....tue istruzioni
[A3].Select
End Sub

se ti rimane attiva una cella alla chiusura non trovi più niente,così costringi il codice all'attivazione della form di posizionarsi alla 1° riga che contiene i tuoi dati.

Ti consiglierei di lavorare con gli intervalli,mettendo nel foglio del tuo DB all'evento Deactivate o Activate la creazione e il ridimensionamento di un intervallo e anche l'ordinamento in base ad una colonna(N° pettorale??) puoi trovare il codice nella sezione,oppure fai un fischio

Ciao

[Robybike]

Grazie Alexsandra mi sei stata di grande aiuto, ho provato a fare quello che mi hai consigliato per l'ordinamento delle colonne con questa formula

Codice: Seleziona tutto

Private Sub CommandButton9_Click()
Ordina

For I = 1 To 4
UserForm1.Controls("TextBox" & I).Text = Sheets(1).Cells(2, I).Value
Next

End Sub


con questa sub

Codice: Seleziona tutto

Sub Ordina()
If OptionButton5.Value = True Then
x = [a3].End(xlDown).Row
Set Ordine = Sheets(1).Range("A3:H" & x)

Ordine.Sort Key1:=Range("A3"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
End If
If OptionButton6.Value = True Then
x = [a3].End(xlDown).Row
Set Ordine = Sheets(1).Range("A3:H" & x)

Ordine.Sort Key1:=Range("B3"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
End If
If OptionButton7.Value = True Then
x = [a3].End(xlDown).Row
Set Ordine = Sheets(1).Range("A3:H" & x)

Ordine.Sort Key1:=Range("c3"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
End If

If OptionButton8.Value = True Then
x = [a3].End(xlDown).Row
Set Ordine = Sheets(1).Range("A3:H" & x)

Ordine.Sort Key1:=Range("d3"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
End If
End Sub


Funziona bene per il nominativo e la categoria, ma ci deve essere qualche cosa che non va con il n° pettorale e N° tessera.

Se mi puoi aiutare!.....

[Alexsandra]

C'è un qualche errore nel codice che hai postato,prova con queste modifiche

Codice: Seleziona tutto

Private Sub CommandButton9_Click()
Ordina
For I = 1 To 4
UserForm1.Controls("TextBox" & I + 1).Text = Sheets(1).Cells(3, I).Value
Next
End Sub

I tuoi dati partono dal box 2 per cui ("TextBox" & I + 1) e i dati nel foglio partono dalla riga 3 per cui Sheets(1).Cells(3, I).Value.
Così l'ordinamento viene eseguito correttamente

[Robybike]

E' quasi fatta, l'unico problema rimasto è quando vado a fare l'ordinamento del N°Pettorale e N°Tessera:

ES: Se deve ordinare numeri come 1,2,3,23,33, gli ordina in questo modo: 1,2,23,3,33.

[Alexsandra]

Li hai formattati come testo,formatta le celle come "Generale" nel file che hai postato l'ordinamento viene eseguito correttamente

[Robybike]

Ci avevo gia pensato, le celle sono tutte formatate come Generale, stò pensando che il problema potrebbe essere sul codice di inserimento dei record.

[Alexsandra]

Codice: Seleziona tutto

If OptionButton5.Value = True Then
x = [a2].End(xlDown).Row
Set Ordine = Sheets(1).Range("A2:H" & x)
Ordine.Sort Key1:=Range("A3"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If

Guarda la differenza nel codice.

[Robybike]

Ho controllato ma mi dà sempre lo stesso errore.

Vedi il file modificato.
http://freefilehosting.net/?id=rdnzk6/c8A==

[Alexsandra]

Non le hai mica fatte tutte le modifiche che ti ho segnalato però.
Ti sistemo il file e in giornata toi posto il link per scaricarlo.

[Alexsandra]

Eccoti il file con le correzioni.
Quando inserisci i valori fallo dal box che vengono già formattati.
Ti posso consigliare di commentare il codice,ti è molto utile quando devi ricercare un problema.
Inoltre quando inserisci i nuovi nominativi,sarebbe opportuno che ti venisse richiesto se inserire ancora oppure no e mettere il focus sul box2.

Cura anche un po la grafica e invece dei soliti tasti ci sono delle icone in rete molto carine,ne faresti anche un bel effetto grafico

http://freefilehosting.net/?id=rdnzkK7Y9g==

[Robybike]

Grazie Alexsandra, mi sei di grande aiuto, per quanto riguarda la graffica è tutta da rifare, questa form non è altro che una parte di un programma che stò creando e non mancherò di farti avere.
Ora ti devo chiedere ancora un consiglio, mi sono accorto che quando vado a fare la ricerca per nome e poi modifico i dati, noto che i record vengono sfalzati di una riga, mentre in tutti gli altri casi funziona tutto correttamente.

[Alexsandra]

Vengo scritti una colonna dopo ma sulla riga giusta. Sostituisci il codice del pulsante con questo

Codice: Seleziona tutto

Private Sub CommandButton3_Click() 'modifica dati
If TextBox2 = "" Then
 MsgBox "Devi Cercare un nominativo per modificarlo"
 Exit Sub
 End If
ActiveCell.Offset(0, -1).Select
ActiveCell.Value = TextBox2.Value
ActiveCell.Offset(0, 1).Value = TextBox3.Value
ActiveCell.Offset(0, 2).Value = TextBox4.Value
ActiveCell.Offset(0, 3).Value = TextBox5.Value

MsgBox "Ok! Eseguito!"
End Sub

[Robybike]

Grazie ancora Alexsandra, scusate il ritardo nella risposta (qualche volta vado in ferie pure io), ci siamo quasi, ora il problema lo riscontro quando vado a fare la ricerca per numero pettorale e poi vado a modificarlo.


Private Sub CommandButton3_Click() 'modifica dati
If TextBox2 = "" Then
MsgBox "Devi Cercare un nominativo per modificarlo"
Exit Sub
End If
ActiveCell.Offset(0, -1).Select ← Stringa di errore
ActiveCell.Value = TextBox2.Value
ActiveCell.Offset(0, 1).Value = TextBox3.Value
ActiveCell.Offset(0, 2).Value = TextBox4.Value
ActiveCell.Offset(0, 3).Value = TextBox5.Value

MsgBox "Ok! Eseguito!"
End Sub

[Alexsandra]

ma hai scaricato il file del mio ultimo link?
il codice è questo

Codice: Seleziona tutto

Private Sub CommandButton3_Click() 'modifica dati
If TextBox2 = "" Then
 MsgBox "Devi Cercare un nominativo per modificarlo"
 Exit Sub
 End If
ActiveCell.Value = TextBox2.Value
ActiveCell.Offset(0, 1).Value = TextBox3.Value
ActiveCell.Offset(0, 2).Value = TextBox4.Value
ActiveCell.Offset(0, 3).Value = TextBox5.Value

MsgBox "Ok! Eseguito!"
End Sub

ho portato la cella attiva alla colonna A mentre fai il cerca per cui quel -1 ti dà errore,ma nel link del mio penultimo post c'è il file funzionante

[Robybike]

Certo che l'ho scaricato, se ricordi avevamo inserito questo codice

Codice: Seleziona tutto

ActiveCell.Offset(0, -1).Select

perche quando, dopo la ricerca per nome e modifica, veniva sfalzato tutto di una riga.
Se lasciamo questa stringa, funziona tutto con la ricerca per nominativo e modifica dando errore invece con la ricerca per numero, mentre se eliminiamo la stringa, il tutto funziona con la ricerca per numero e modifica, dando l'errore su quella per nominativo.