Condividi:        

Implementazione di ricerca valore su vari files

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

Implementazione di ricerca valore su vari files

Postdi BG66 » 24/01/17 23:24

Ciao a tutti,
adattando le indicazioni di Anthony ( che ringrazio e saluto) contenute in questo thread http://www.pc-facile.com/forum/viewtopic.php?t=105457 ho ottenuto quanto mi necessitava.

Ma ho bisogno di un "piccolo" aiuto per customerizzare ulteriormente lo script.

In breve, quando lancio la macro vorrei:
1) che mi chiedesse se voglio pulire i dati esistenti nel foglio ( al momento le interrogazioni si sommano accodandosi tra di loro) -> se SI cancella i dati presenti dalla riga 2 in giù, altrimenti continua ad accodarli.
2) riportare il numero di stringa digitato con la macro -> nella colonna D e creare un linea alla fine dell'ultimo dato trovato.

Lo script modificato è il seguente:
Codice: Seleziona tutto
Sub myRiepilogo2()

Dim myMatch, myDir, myFile, i As Long, myNext As Long, myRiep As Worksheet, myLFor, myTot As Long
     myLFor = InputBox("Digita la stringa da ricercare ")
    If myLFor = "" Then
        MsgBox ("Nessuna stringa specificata, la procedura viene interrotta...")
        Exit Sub
    End If
    If IsNumeric(myLFor) Then myLFor = CDbl(myLFor)
    myDir = "C:\Users\Bove\Downloads\Prova"    '<<< La directory dei file, senza \ finale
    Set myRiep = ThisWorkbook.Sheets("RIEP")
    myFile = Dir(myDir & "\*.xls*")
    Do While myFile <> ""
    If myFile = "Riepilogo.xlsm" Then Exit Do
        Workbooks.Open Filename:=(myDir & "\" & myFile), ReadOnly:=True
        For i = 1 To Worksheets.Count
            jj = Sheets(i).Cells(Rows.Count, 3).End(xlUp).Row
            For j = 4 To jj
                If Sheets(i).Cells(j, 3) = myLFor Then
                  myTot = myTot + 1
                  myNext = myRiep.Cells(Rows.Count, 1).End(xlUp).Row + 1
                  myRiep.Cells(myNext, 1) = ActiveWorkbook.Name
                  myRiep.Cells(myNext, 2) = Sheets(i).Name
                  myRiep.Cells(myNext, 3) = j
                End If
            Next j    'variata da me - era JJ
        Next i
        ActiveWorkbook.Close False
        myFile = Dir
    Loop
    MsgBox ("Completato (" & myTot & " prodotto trovato)")
End Sub


https://www.dropbox.com/s/91uxt6fx6mjgsxd/Riepilogo.xlsm?dl=0

Grazie in anticipo
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Sponsor
 

Re: Implementazione di ricerca valore su vari files

Postdi Anthony47 » 25/01/17 01:08

Quasi tutto chiaro; quasi.
Vuoi quindi inserire in D1 la stringa (il valore) che poi ricerchi tramite la macro.
Inoltre, terminata la ricerca e inseriti i dati nel riepilogo vorresti che le celle AD dell'ultima riga usata abbiano il bordo come nell'esempio che hai pubblicato.
Se Si e Si, allora:
1) aggiungi questa istruzione in questa posizione:
Codice: Seleziona tutto
    If IsNumeric(myLFor) Then myLFor = CDbl(myLFor)
    Range("D1").Value = myLFor                             '++++
    myDir = "C:\Users\UTENTE\Downloads\Prova"    '<<< La directory dei file, senza \ finale

2) in coda, aggiungi questo blocco in questa posizione:
Codice: Seleziona tutto
    Loop
'AGGIUNGI QUESTO BLOCCO:
    With Cells(Rows.Count, 1).End(xlUp).Resize(1, 4).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With                    'FINE AGGIUNTA
    MsgBox ("Completato (" & myTot & " prodotto trovato)")

Se No, No ...beh allora devi spiegare nuovamente con altre parole
Avatar utente
Anthony47
Moderatore
 
Post: 19183
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Implementazione di ricerca valore su vari files

Postdi BG66 » 26/01/17 11:25

Ciao Anthony,
l'ennesimo grazie per la tua disponibilità.

Parto da quanto già fatto.
Per il punto 2 (ossia riportare il numero di stringa digitato con la macro -> nella colonna D e creare un linea alla fine dell'ultimo dato trovato), spero che un mix tra parole ed immagini possa aiutarti ad aiutarmi:

Immagine

Quindi è ok la riga a fine ricerca mentre il codice ricercato dovrebbe essere posizionato a lato della riga ricercata per ogni riga della stessa.

Per il punto 1:
Dall'immagine precedente nella parte del dato atteso,si vede che la ricerca stringa 1246 si è accodata alla precedente ricerca (1243) e questo và benissimo in caso di necessità multiple. Ma al momento nel caso di una nuova ricerca,devo cancellare i campi precedentemente salvati o comunque presenti per avviare quella nuova partendo da zero.

Ovviamente il cancellare "quattro dati in croce" NON è un problema ma mi piacerebbe capire come si fà ad inserire nello script l'opzione "vuoi cancellare tutti i campi compilati?" se si -> eseguo.... altrimento "accodo".

PS: Ovviamente dalla cancellazione andrebbe esclusa la riga 1 (l'intestazione).

Grazie ancora.
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: Implementazione di ricerca valore su vari files

Postdi Anthony47 » 26/01/17 14:26

Credo di aver capito...
Allora rimuovi (se mai l'hai inserita) la riga Range("D1").Value = myLFor

Aggiungi invece questa riga in questa posizione:
Codice: Seleziona tutto
                  myRiep.Cells(myNext, 3) = j
                  myRiep.Cells(myNext, 4) = myLFor         '<<<< QUESTA!
                End If

Questa aggiunge la chiave cercata in colonna D.

Per la richiesta Cancella /Accoda, inserisci questo blocco in questa posizione:
Codice: Seleziona tutto
    myDir = "C:\Users\Bove\Downloads\Prova"    '<<< La directory dei file, senza \ finale
    Set myRiep = ThisWorkbook.Sheets("RIEP")
'BLOCCO DA AGGIUNGERE...
    Azione = InputBox("Inserisci CANCELLA per cancellare l'elenco preesistente, oppure premi Ok per Accodare" & _
       " o Annulla per Interrompere", "CANCELLA Elenco /ACCODA /INTERROMPI?", "Accoda")
    If Azione = "CANCELLA" Then
        With myRiep.Range("A2").Resize(10000, 5)
            .ClearContents
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
    ElseIf Azione = "" Then
        MsgBox ("Procedura interrotta")
        Exit Sub
    End If
'...FINE BLOCCO
    myFile = Dir(myDir & "\*.xls*")

La mia scelta e' di chiedere all'utente di scrivere la stringa "CANCELLA" se vuole cancellare l'elenco, altrimenti si Accoda oppure si Interrompe a seconda del pulsante premuto sul secondo InputBox.

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

Re: Implementazione di ricerca valore su vari files

Postdi BG66 » 26/01/17 18:26

[RISOLTO]
Ciao Anthony è perfetta.
Per i posteri, di seguito risultato finale:
Codice: Seleziona tutto
Sub myRiepilogo2()

Dim myMatch, myDir, myFile, i As Long, myNext As Long, myRiep As Worksheet, myLFor, myTot As Long
    myLFor = InputBox("Digita la stringa da ricercare ")
    If myLFor = "" Then
        MsgBox ("Nessuna stringa specificata, la procedura viene interrotta...")
        Exit Sub
    End If
    If IsNumeric(myLFor) Then myLFor = CDbl(myLFor)
    myDir = "C:\Users\Bv\Downloads\Prova"    '<<< La directory dei file, senza \ finale
    Set myRiep = ThisWorkbook.Sheets("RIEP")
    Azione = InputBox("Inserisci CANCELLA per cancellare l'elenco preesistente, oppure premi Ok per Accodare" & _
       " o Annulla per Interrompere", "CANCELLA Elenco /ACCODA /INTERROMPI?", "Accoda")
    If Azione = "CANCELLA" Then
        With myRiep.Range("A2").Resize(10000, 5)
            .ClearContents
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
    ElseIf Azione = "" Then
        MsgBox ("Procedura interrotta")
        Exit Sub
    End If
    myFile = Dir(myDir & "\*.xls*")
    Do While myFile <> ""
    If myFile = "Riepilogo.xlsm" Then Exit Do
        Workbooks.Open Filename:=(myDir & "\" & myFile), ReadOnly:=True
        For i = 1 To Worksheets.Count
            'For jj = 1 To Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
            jj = Sheets(i).Cells(Rows.Count, 3).End(xlUp).Row
            For j = 4 To jj
                If Sheets(i).Cells(j, 3) = myLFor Then
                    myTot = myTot + 1
                    myNext = myRiep.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    myRiep.Cells(myNext, 1) = ActiveWorkbook.Name
                    myRiep.Cells(myNext, 2) = Sheets(i).Name
                    myRiep.Cells(myNext, 3) = j
                    myRiep.Cells(myNext, 4) = myLFor       
                    End If
            Next j   
        Next i
        ActiveWorkbook.Close False
    myFile = Dir
    Loop
    With Cells(Rows.Count, 1).End(xlUp).Resize(1, 4).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With                   
    MsgBox ("Completato (" & myTot & " prodotto trovato)")
End Sub


Ennesimo grazie e alla prossima.
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44


Torna a Applicazioni Office Windows


Topic correlati a "Implementazione di ricerca valore su vari files":

BTp Valore
Autore: MarioLombardi
Forum: Forum off-topic
Risposte: 2

Chi c’è in linea

Visitano il forum: Nessuno e 48 ospiti