archivio CD

[raimea]

ciao
sto realizzando un semplice file per l' archivio musicale di CD
sono a buon punto, mi servirebbe aiuto per la parte della ricerca.

in fgl cerca
scrivo in D4 la parola o parte di parola da cercare in fgl elenco,
andando a cercarla in tutte e 5 le colonne da D7:H
e riportare i risultati in fgl cerca da riga D7

ES:
se scrivo vasco
dovra' riportarmi tutto cio che contiene.
vasco
oppure solo ..sco

spero di essermi spiegato

vi allego il file

https://www.dropbox.com/scl/fi/m4y7eo4lx7oquzt59dzp9/archivio_cd.xlsm?rlkey=x06hm6i6n3sfbi8lrnfd3biji&st=wksmsoo3&dl=0

ciao

[Raffaele53]

Da provare

Codice: Seleziona tutto

Option Explicit
Option Compare Text
Sub Cerca()
Dim F1 As Worksheet: Set F1 = Worksheets("Elenco")
Dim F2 As Worksheet: Set F2 = Worksheets("cerca")
Dim Ur As Long, X As Long, Rg As Long, Rr As Long, Rx As Long, Txt As String
Ur = F2.Range("D" & Rows.Count).End(xlUp).Row
If Ur > 6 Then F1.Range("D7:H" & Ur) = ""
Ur = F1.Range("D" & Rows.Count).End(xlUp).Row
Txt = F2.Range("D4")
If Txt = "" Then Exit Sub
Rr = 7
Rg = Rr
F1.Activate
    For X = 7 To Ur
        F1.Range("D" & X).Activate
        F1.Cells.Find(What:=Txt, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
        Rx = Selection.Row
        If Rg <> Rx Then
            F1.Range(F1.Cells(Rx, "D"), F1.Cells(Rx, "H")).Copy
            F2.Range("D" & Rr).PasteSpecial
            Rg = Rx
            Rr = Rr + 1
            X = Rx + 1
        End If
    Next
F2.Activate
Set F1 = Nothing
Set F2 = Nothing
End Sub

[Anthony47]

Probabilmente Raffaele (ciao!) ti sta proponendo una soluzione piu' adeguata alla tua richiesta (vedi messaggio prima di questo mio).

Io in prima battuta ti manderei a provare il metodo presentato in questo file sviluppato tempo fa per altro utente:
https://www.dropbox.com/scl/fi/y6qy169d ... tt7kw&dl=0

In particolare, parti da Foglio1 e premi “Show Form”
Ti verra’ aperta una userform che contiene un ListBox a 5 colonne e un textbox che contiene tutte le righe di quel foglio. Man mano che scrivi qualcosa nel textbox nel listbox saranno mostrate solo le righe che in una delle 5 colonne contengono la stringa digitata. Inoltre e’ possibile, tramite una serie di radiobutton, scegliere quale colonna ordinare.
Infine un pulsante OK scrive i risultati filtrati nella posizione predeterminata (io ho impostato Foglio2!D5)

La posizione del database e la posizione di scrittura sono da impostare nella Sub UserForm_Initialize (le tre righe marcate <<<)

Se vuoi prova e fai sapere...

[raimea]

ciao
la soluzione raffaele
Non va bene
mi riporta solo la prima riga che trova
e non tutte le righe con stessa parola/frase

inoltre se scrivo CD
sembra vada in loop e non si ferma piu
------
ora se riesco applico al mio file
la prova indicata da antony

faccio sapere
grazie


EDIT:
errore mio , non e vero che:

mi riporta solo la prima riga che trova
e non tutte le righe con stessa parola/frase

[raimea]

ciao
sono riuscito a importare la useform ecc.. "show form"
e a farla funzionare.

sono a chiedere come migliorarla in 2 cose.

1_pulire tutto il foglio di destinazione "cerca"
prima di scriverci i nuovi dati.

2_ al preme del pulsante OK nella useform
portarmi direttamente nel fgl cerca.

vi allego il file aggiornato

https://www.dropbox.com/scl/fi/gzlp6710doq58p5r8b12o/archivio_cd_V2.xlsm?rlkey=lqb175bk42sujg4ic2slo08uf&st=69m0105r&dl=0

grazie

[Anthony47]

Si puo' fare in vari modi, ad esempio lavorando sulla Sub CB1_Click, che comunque e' da modificare perche' mi sono accorto che se il risultato e' su 1 sola riga l'output viene sbagliato. Il nuovo codice:

Codice: Seleziona tutto

Private Sub CB1_Click()
oPos.Resize(10000, 5).Clear             '.ClearContents ??
If UBound(sArr, 2) > 1 Then
    oPos.Resize(UBound(sArr), UBound(sArr, 2)).Value = sArr
Else
    oPos.Resize(UBound(sArr, 2), UBound(sArr)).Value = Application.WorksheetFunction.Transpose(sArr)
End If
Application.Goto Sheets("cerca").Range("D6")
'Unload Me                     ' VEDI TESTO
End Sub

Se col pulsante OK si vuole anche chiudere la userform allora bisogna "scommentare" (cioe' togliere l'apostrofo a inizio riga) l'istruzione Unload Me