Condividi:        

cerca nomi

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

cerca nomi

Postdi trittico69 » 23/05/12 16:41

è possibile modificare il codice sotto e fare in modo che mi effettui prima la ricerca prima nella colonna AB3:AB100 e se non trova il nome che si stà cercando passi automaticamente alla colonna A3:B2000.
Questo codice si trova in una form.
Grazie!

Codice: Seleziona tutto
Dim ricerca As Range 'questo codice serve a creare il tasto cerca per non usare il binocolo e finisce a fine3
Private Sub CommandButton1_Click()
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
If ricerca Is Nothing Then
Set ricerca = Sheets("archivio").Cells.Find(TextBox1.Text, , xlValues)
Else
Set ricerca = Sheets("archivio").Cells.Find(TextBox1.Text, Sheets("archivio").Cells(ricerca.Row, ricerca.Column), xlValues)
End If
If ricerca Is Nothing Then Exit Sub
ricerca.Select
End Sub
Private Sub UserForm_Activate()
TextBox1.SetFocus
End Sub

Private Sub UserForm_initialize()
CommandButton1.Caption = "trova": CommandButton1.Accelerator = "T": CommandButton1.Default = True
userform1.Caption = "cerca"
End Sub 'fine3
trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Sponsor
 

Re: cerca nomi

Postdi trittico69 » 24/05/12 13:18

trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Re: cerca nomi

Postdi Flash30005 » 24/05/12 15:55

Prova a sostituire solo questa macro
Codice: Seleziona tutto
Private Sub CommandButton1_Click()
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
If ricerca Is Nothing Then
For CC = 1 To 3
Select Case CC
Case 1
Col = 28
Riga = 100
Case 2
Col = 1
Riga = 2000
Case 3
Col = 2
Riga = 2000
End Select
Range(Cells(2, Col), Cells(Riga, Col)).Select
Set ricerca = Sheets("archivio").Cells.Find(TextBox1.Text, , xlValues)
Next CC
Else
Set ricerca = Sheets("archivio").Cells.Find(TextBox1.Text, Sheets("archivio").Cells(ricerca.Row, ricerca.Column), xlValues)
End If
If ricerca Is Nothing Then Exit Sub
ricerca.Select
End Sub


Ciao

P.s. La seconda parte della macro (Else) non ho ben capito a cosa ti serve...
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: cerca nomi

Postdi trittico69 » 07/06/12 15:33

flash ti allego il file con la tua modifica ma sembra non funzionare..in pratica mi dovrebbe trovare, scrivendo 'tre' nella finestra di ricerca dopo aver premuto il tatso rosso, prima la parole in AB5 e poi quella in A4
http://depositfiles.com/files/ongekwwdb
trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Re: cerca nomi

Postdi Anthony47 » 07/06/12 21:27

Prova a sostituire la tua Sub CommandButton1_Click() con questa:
Codice: Seleziona tutto
Private Sub CommandButton1_Click()
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
'
With Worksheets("Archivio").Range("AB3:AB100, A3:B2000")
    Set c = .Find(TextBox1.Text, LookIn:=xlValues)
    If Not c Is Nothing Then c.Select
End With
End Sub


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cerca nomi

Postdi trittico69 » 08/06/12 19:12

anthoni sembra funzionare ma se per esempio digito la parola 'uno' e premo enter me la trova ma se dopo riclicco enter per vedere se c'è un altra parola uguale non mi continua...
trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Re: cerca nomi

Postdi Anthony47 » 11/06/12 00:17

ma se dopo riclicco enter per vedere se c'è un altra parola uguale non mi continua...
Semplicemente perche' la richiesta iniziale non prevedeva il continuare la ricerca...

Cancella la precedente Private Sub CommandButton1_Click() e inserisci questo codice

Codice: Seleziona tutto
Dim myPrimo As Range, myCorr As Range '<< IN TESTA AL MODULO
'
Private Sub CommandButton1_Click()
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
'
With Worksheets("Archivio").Range("AB3:AB100, A3:B2000")
    If myPrimo Is Nothing Then
        Set c = .Find(TextBox1.Text, LookIn:=xlValues)
    Else: Set c = .FindNext(myCorr)
    End If
'
    If c Is Nothing Then Exit Sub
'    If Not myPrimo Is Nothing Then If c = myPrimo Then Exit Sub
    c.Select
    If myPrimo Is Nothing Then Set myPrimo = c  ': Exit Sub
    Set myCorr = c
End With
End Sub

Private Sub TextBox1_Change()
Set myPrimo = Nothing
End Sub

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cerca nomi

Postdi trittico69 » 11/06/12 18:58

sembra andare bene...domanilo provo sul file originale....potrsti fare un aggiunta e cioè che mi trovi anche le parole scritte nei commenti? in questo caso non importa dove inizia a cercare..
trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Re: cerca nomi

Postdi Anthony47 » 12/06/12 00:55

Cercare su paginebianche.it no? :D
Sostituisci le dichiarazioni iniziali con
Codice: Seleziona tutto
Dim myPrimo As Range, myCorr As Range, myK1 As Long

e la macro di CommandButton1_Click con
Codice: Seleziona tutto
Private Sub CommandButton1_Click()
Dim I As Long
RAvvia:
userform1.Caption = "CERCA in cella"
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
'
With Worksheets("Archivio").Range("AB3:AB100, A3:B2000")
    If myPrimo Is Nothing Then
        myK1 = 0
        Set c = .Find(TextBox1.Text, LookIn:=xlValues)
    Else: Set c = .FindNext(myCorr)
    End If
'
    If c Is Nothing Then GoTo CkCmt
    If Not myPrimo Is Nothing Then If c = myPrimo Then GoTo CkCmt
    c.Select
    If myPrimo Is Nothing Then Set myPrimo = c  ': Exit Sub
    Set myCorr = c: userform1.Caption = "TROVATO in cella"
End With
Exit Sub
'
CkCmt:
userform1.Caption = "CERCA in commento"
'myK1 = 0
For I = myK1 + 1 To Sheets("Archivio").Comments.Count
aaa = Worksheets("Archivio").Comments(I).Text
Set Kmt = Worksheets("Archivio").Comments(I)
    If Not Application.Intersect(Kmt.Parent, Range("AB3:AB100, A3:B2000")) Is Nothing Then
        If Len(UCase(Kmt.Text)) > Len(Replace(UCase(Kmt.Text), UCase(TextBox1.Text), "")) Then
'            If Not myCorr Is Nothing Then If c = myCorr Then GoTo CkCmt
            myK1 = I: Kmt.Parent.Select
            userform1.Caption = "TROVATO in commento": Exit Sub
        End If
    End If
Next
'
FineKmt:
Set myPrimo = Nothing: GoTo RAvvia
End Sub

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cerca nomi

Postdi trittico69 » 12/06/12 06:46

mi cerca nel commento ma se riclicco enter per vedere se c'è un'altra parola simile non mi fa andare avanti
trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Re: cerca nomi

Postdi Flash30005 » 12/06/12 09:28

Ho ripreso il file e la macro che avevo postato accorgendomi del bug che ora dovrebbe essere corretto
sostituisci l'intero codice dell'UserForm con questo
Codice: Seleziona tutto
Public CC As Integer
Public ricerca As Range 'questo codice serve a creare il tasto cerca per non usare il binocolo e finisce a fine3
Private Sub CommandButton1_Click()
CC = CC + 1
TrovaP
End Sub
Private Sub UserForm_Activate()
TextBox1.SetFocus
End Sub
Private Sub UserForm_initialize()
CC = 0
CommandButton1.Caption = "trova": CommandButton1.Accelerator = "T": CommandButton1.Default = True
userform1.Caption = "cerca"
End Sub 'fine3
Sub TrovaP()
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
'If ricerca Is Nothing Then
Select Case CC
Case 1
Col = 28
Riga = 100
Case 2
Col = 1
Riga = 2000
Case 3
Col = 2
Riga = 2000
End Select
On Error GoTo ErrorF
Range(Cells(2, Col), Cells(Riga, Col)).Select
   Selection.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
On Error GoTo 0
If ricerca Is Nothing Then Exit Sub
ricerca.Select
ErrorF:
userform1.Hide
On Error GoTo 0
End Sub


Fai sapere
Ciao

N.B: ad ogni clcik cambia la colonna di selezione pertanto in caso di più parole identiche nella stessa colonna potresti avere un problema di ricerca
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: cerca nomi

Postdi Anthony47 » 12/06/12 12:20

Flash, ma la tua macro cerca anche nei commenti?

Per Trittico: in effetti la macro pubblicata ieri sera si impalla se non esiste il valore cercato :oops:
Questa mi pare collaudata meglio, sostituiscila all' attuale CommandButton1_Click:
Codice: Seleziona tutto
Private Sub CommandButton1_Click()
Dim I As Long
RAvvia:
userform1.Caption = "CERCA in cella"
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
'
With Worksheets("Archivio").Range("AB3:AB100, A3:B2000")
    If myPrimo Is Nothing Then
        myK1 = 0
        Set c = .Find(TextBox1.Text, LookIn:=xlValues)
    Else: Set c = .FindNext(myCorr)
    End If
'
    If c Is Nothing Then GoTo CkCmt
    If Not myPrimo Is Nothing Then If c = myPrimo Then GoTo CkCmt
    c.Select
    If myPrimo Is Nothing Then Set myPrimo = c  ': Exit Sub
    Set myCorr = c: userform1.Caption = "TROVATO in cella"
End With
Exit Sub
'
CkCmt:
userform1.Caption = "CERCA in commento"
If myPrimo Is Nothing Then Set myPrimo = ActiveCell
If myCorr Is Nothing Then Set myCorr = ActiveCell
'myK1 = 0
For I = myK1 + 1 To Sheets("Archivio").Comments.Count
'aaa = Worksheets("Archivio").Comments(I).Text
Set Kmt = Worksheets("Archivio").Comments(I)
    If Not Application.Intersect(Kmt.Parent, Range("AB3:AB100, A3:B2000")) Is Nothing Then
        If Len(UCase(Kmt.Text)) > Len(Replace(UCase(Kmt.Text), UCase(TextBox1.Text), "")) Then
'            If Not myCorr Is Nothing Then If c = myCorr Then GoTo CkCmt
            myK1 = I: Kmt.Parent.Select
            userform1.Caption = "TROVATO in commento": Exit Sub
        End If
    End If
Next
'
FineKmt:
userform1.Caption = "------> FINE RICERCA"
Set myPrimo = Nothing ': GoTo RAvvia
End Sub

Ciao a tutti.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cerca nomi

Postdi Flash30005 » 12/06/12 13:46

Anthony47 ha scritto:Flash, ma la tua macro cerca anche nei commenti?

:roll:
No!
certo che di richieste "strane" ce ne sono a iosa...

Ciao a tutti
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: cerca nomi

Postdi trittico69 » 12/06/12 17:43

C’è ancora qualcosa che non va ti allego il file..se cerchi la parola ‘sette che si trova in tre commenti me ne cerca uno solo…poi se scrivo ‘un’me ne cerca uno solo se invece scrivo ‘no’ me li cerca tutti…dopo di questo mi faresti un(spero)ultima modifica?Ho messo, nella from, due caselle di controllo una si chiama presenti una usciti, puoi aggiungere il necessario al codice in modo che possa decidere, spuntando uno delle due caselle, se effettuare la ricerca nel foglio archivio(nome casella di controllo presenti) o nel foglio usciti(nome casella di controllo usciti)?.. grazie!
http://depositfiles.com/files/s6nz61eg2
trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Re: cerca nomi

Postdi Anthony47 » 13/06/12 00:23

Quando si costruisce a strati le cose vanno sempre storte...

1) non hai dichiarato in testa myK1 As Long; la riga completa e'
Codice: Seleziona tutto
Dim myPrimo As Range, myCorr As Range, myK1 As Long '<< IN TESTA AL MODULO

2) sostituisci la riga
If Not myPrimo Is Nothing Then If c = myPrimo Then GoTo CkCmt
con
If Not myPrimo Is Nothing Then If c.Address = myPrimo.Address Then GoTo CkCmt '<<<

Per quanto riguarda il lavoro da fare su Archivio o Presenti il mio suggerimento e'che invece delle Caselle di controllo usi due "Pulsanti di opzione", che sono mutuamente esclusivi.
Il codice dei pulsanti sara'
Codice: Seleziona tutto
Private Sub OptionButton1_Click()  '<<*
If OptionButton1.Value = True Then
    Sheets("Archivio").Select
    Set myPrimo = Nothing
End If
End Sub

Private Sub OptionButton2_Click()  '<<*
If OptionButton2.Value = True Then
    Sheets("Presenti").Select
    Set myPrimo = Nothing
End If
End Sub


Poi nella Sub CommandButton1_Click sostituisci tutte le occorrenze di
Worksheets("Archivio").
con
ActiveSheet.

Fai in modo che la form di Cerca si possa attivare solo sul foglio Archivio o Presenti (cioe' non mettere il pulsante di attivazione in altri fogli), poi durante l' uso azionando i "Pulsanti di opzione" verra' attivato un foglio oppure l' altro, e su di esso si eseguira' la ricerca.

Che sia l' ultima?

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cerca nomi

Postdi trittico69 » 13/06/12 17:44

Sia se clicco sul pulsante “usciti” che sul pulsante “presenti” mi dice necessario oggetto
Questo e tutto il codice
Dove sbaglio?

Codice: Seleziona tutto
Dim myPrimo As Range, myCorr As Range, myK1 As Long 'questo codice cerca nel foglio archivio sia nelle celle che nei commenti
Private Sub CommandButton1_Click()
Dim I As Long
RAvvia:
userform1.Caption = "CERCA in cella"
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
'
With ActiveSheet.Range("AB3:AB100, A3:B2000")
    If myPrimo Is Nothing Then
        myK1 = 0
        Set c = .Find(TextBox1.Text, LookIn:=xlValues)
    Else: Set c = .FindNext(myCorr)
    End If
'
    If c Is Nothing Then GoTo CkCmt
    If Not myPrimo Is Nothing Then If c.Address = myPrimo.Address Then GoTo CkCmt
    c.Select
    If myPrimo Is Nothing Then Set myPrimo = c  ': Exit Sub
    Set myCorr = c: userform1.Caption = "TROVATO in cella"
End With
Exit Sub
'
CkCmt:
userform1.Caption = "CERCA in commento"
If myPrimo Is Nothing Then Set myPrimo = ActiveCell
If myCorr Is Nothing Then Set myCorr = ActiveCell
'myK1 = 0
For I = myK1 + 1 To Sheets("Archivio").Comments.Count
'aaa = ActiveSheet.Comments(I).Text
Set Kmt = ActiveSheet.Comments(I)
    If Not Application.Intersect(Kmt.Parent, Range("AB3:AB100, A3:B2000")) Is Nothing Then
        If Len(UCase(Kmt.Text)) > Len(Replace(UCase(Kmt.Text), UCase(TextBox1.Text), "")) Then
'            If Not myCorr Is Nothing Then If c = myCorr Then GoTo CkCmt
            myK1 = I: Kmt.Parent.Select
            userform1.Caption = "TROVATO in commento": Exit Sub
        End If
    End If
Next
'
FineKmt:
userform1.Caption = "------> FINE RICERCA"
Set myPrimo = Nothing ': GoTo RAvvia
End Sub


Private Sub CommandButton2_Click()
If OptionButton2.Value = True Then
Sheets("Archivio").Select
Set myPrimo = Nothing
End If
End Sub



Private Sub CommandButton3_Click()
If OptionButton3.Value = True Then
Sheets("Presenti").Select
Set myPrimo = Nothing
End If

End Sub

Private Sub TextBox1_Change()
Set myPrimo = Nothing
End Sub




Private Sub UserForm_Activate()
TextBox1.SetFocus
End Sub

Private Sub UserForm_initialize()
CommandButton1.Caption = "trova": CommandButton1.Accelerator = "T": CommandButton1.Default = True
userform1.Caption = "cerca"
End Sub



E ti allego comunque il file.

http://depositfiles.com/files/a42edqmjt
trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Re: cerca nomi

Postdi Anthony47 » 13/06/12 23:10

Nella form devi inserire due "OptionButton", non "CommandButton":
Immagine

Uploaded with ImageShack.us
(oppure adatti il codice dei eliminando le righe If / end if)

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cerca nomi

Postdi trittico69 » 14/06/12 16:55

Fatto ma se vado nel foglio usciti e cerco la parola ‘sette’ che si trova in più commenti me ne trova solo due.
E poi mi farebbe comodo, se si puo fare, che se clicco su uno dei due tasti per cambiare foglio ed effettuare la ricerca mi dovrebbe permettere immediatamente di premere enter e subito cercare la parola.. invece com’è adesso quando clicco su un tasto prima devo ciccare nella finestra dov’è la parola e poi posso premere enter per effettuare la ricerca.
E lo so che ti avevo detto che forse era l’ultima ma avevo detto forse..scherzo…ma se mi faresti un altro favore e cioè nella stessa from inserirei una casella di controllo che se viene spuntata mi cerca la parola intera e se questa casella oltre a poterla spuntare con il muse si potesse spuntare anche premendo ctrl+i.
Ciao!
Ti allego sempre il file.
http://depositfiles.com/files/2dm5yzkbs
trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Re: cerca nomi

Postdi Anthony47 » 14/06/12 23:07

Non trovi tutti i "sette" del foglio Usciti perche' non hai sostituito TUTTE le occorrenze di Sheets("Archivio") con ActiveSheet. In particolare non devi usare
For I = myK1 + 1 To Sheets("Archivio").Comments.Count
Ma
For I = myK1 + 1 To ActiveSheet.Comments.Count

Per quanto riguarda le modalita' di ricerca, quando cambi foglio PUOI premere subito "Trova"; se invece vuoi usare il tasto Enter o modificare la stringa di ricerca devi prima selezionare il contenuto del textbox.
Puoi ripristinare la selezione aggiungendo l' istruzione SetFocus all' interno del codice dei due pulsanti aggiunti; esempio:
Codice: Seleziona tutto
Sheets("usciti").Select    'Esistente
TextBox1.SetFocus       'AGGIUNTA

Hai inoltre erroneamente rimosso anche le istruzioni Set myPrimo=Nothing; vanno ripristinate (all' interno del codice che gestisce i pulsanti di selezione fogli); la versione corretta e':
Codice: Seleziona tutto
Set myPrimo = Nothing     'SERVE!
'End If


Per quanto riguarda il checkbutton aggiuntivo, dovresti specificare meglio che cosa intendi per "cercare la parola intera". Ora se scrivi "monte" ti trovera' i vari monte, montella, delmonte, monte leggero, mazzanti vien dal monte, cordero di montezemolo, smontero, e cosi' via; tu invece che cosa vorresti?

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cerca nomi

Postdi trittico69 » 15/06/12 06:57

se scrivo monte mi deve cercare solo monte spuntando la casella
trittico69
Utente Senior
 
Post: 497
Iscritto il: 16/08/09 18:41

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "cerca nomi":


Chi c’è in linea

Visitano il forum: Nessuno e 19 ospiti