MACRO CERCA VALORI

[thunderPartecipante thunder]

Ciao,

 

questo il mio quesito:

 

Ho una cartella di lavoro contenente cartelle excel in numero variabile.

All'interno di queste cartelle excel ho determinati valori tipo "pippo" ,"topolino" che si possono ripetere.

Il mio obbiettivo è creare una macro su una cartella excel differente all'interno della stessa cartella di lavoro, che mi conti il numero delle volte che tali valori vengono ripetuti.

I valori devono essere ricercati per corrispondenza esatta; non devono essere nella stessa cella ( es: pippofragola).

 

Grazie

 

 

 

 

[albatros54Moderatore albatros54 Karma: 89 pts]

Se ti è possibile allega un file, senza dati sensibili, con i dati di partenza e la soluzione che vorresti ottenere

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[thunderPartecipante thunder]

Ciao,

ecco il materiale in allegato.

Grazie

[thunderPartecipante thunder]

Riallego i file.

Allegati:

You must be logged in to view attached files.

[patelModeratore patel Karma: 51 pts]

i dati da cercare e conteggiare sono già noti ? la ricerca è da fare solo sulla colonna C ?

[albatros54Moderatore albatros54 Karma: 89 pts]

Scenario:

in una dir hai il file "resoconto.xlsm"

dentro questa dir hai un'altra dir nominata"cartella" dove si trovano i file che tu devi ciclare, incolla il codice postato in un modulo del file "resoconto.xlsm" e lanci la sub "ricerca".

Naturalmente devi sostituire il precorso nella Sub ricerca.

Option Explicit

Public Sub mRicerca(ByVal vRicerca As Variant, sPath As String)


    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim wk As Workbook
    Dim sh As Worksheet
    Dim shMe As Worksheet
    Dim lUltRiga As Long
    Dim c As Range
    Dim totale As Integer


    With Application
        .ScreenUpdating = False
    End With
    Set shMe = ThisWorkbook.Worksheets("Foglio1")
    totale = 0
    With shMe
        lUltRiga = .Range("g"& Rows.Count).End(xlUp).Row
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)
    For Each objFile In objFolder.Files
        Select Case LCase(Right(objFile.Name, 4))
            Case ".xls", "xlsx", "xlsm"
                Set wk = Workbooks.Open(objFile.Path)
                For Each sh In wk.Worksheets
                    For Each c In sh.UsedRange
                        If c.Value = vRicerca Then
                            totale = totale + 1
                            lUltRiga = lUltRiga + 1
                            shMe.Range("g" & lUltRiga).Value = objFile.Name
                            shMe.Range("h" & lUltRiga).Value = sh.Name
                            shMe.Range("i" & lUltRiga).Value = c.Address(False, False)
                            shMe.Range("j" & lUltRiga).Value = vRicerca
                            shMe.Range("l" & lUltRiga).Value = totale
                        End If
                    Next
                    wk.Close
                    Set wk = Nothing
                Next
                totale = 0
        End Select
    Next
    With Application
        .ScreenUpdating = True
    End With

    Set c = Nothing
    Set wk = Nothing
    Set sh = Nothing
    Set shMe = Nothing
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing

End Sub


Public Sub Ricerca()
    Dim ultimariga As Integer
    Dim rng As Range
    Dim cl As Range

    ultimariga = Cells(Rows.Count, 2).End(xlUp).Row
    Set rng = Range(Cells(1, 2), Cells(ultimariga, 2))
    For Each cl In rng
        Call mRicerca(cl, "C:\Users\Utente\Desktop\prova\Cartella") ' da modificare
    Next

End Sub

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[thunderPartecipante thunder]

@patel la ricerca andrebbe effettuata su tutto il foglio.

@Albratos54 ho eseguito la macro mi ha dato questo come risultato:

test_2.xlsx  Sheet1 C4                    1

Ho sbagliato qualcosa nell'eseguire?

Io vorrei che venissero riassunti determinati valori prestabiliti (in questo caso topolino, pippo..) come nel file di resoconto allegato

Grazie

[albatros54Moderatore albatros54 Karma: 89 pts]

test_2.xlsx Sheet1 C4 1

ti dice che nel file test_2.xlsx foglio sheets1 alla cella C4 è stato trovata una corrispondenza.
poi nella colonna j ti dovrebbe stampare il dato trovato

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[thunderPartecipante thunder]

Innanzi tutto grazie...Dunque se apro il file test_2 la cella C4 è vuota...

Dove discrimino i dati da cercare nella macro?

[albatros54Moderatore albatros54 Karma: 89 pts]

Tu non devi aprire i file dove cercare, perchè li apre e chiude la macro, tu devi solo lanciare la macro ricerca dal file resoconto, ripsettando le dir ,e ti ritrovarai i dati della ricerca nel foglio.

C'è da apportare una piccolo modifica, che per il momento tralascio.

i dati li puoi introdurre a partire dalla cella "b1" per tutta la colonna, nel file "Resoconto"

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[thunderPartecipante thunder]

Ho fatto un po di prove.. ora ho capito come funziona. Ho notato che se lo stesso valore ricade nella stessa riga, quello precedente viene riconteggiato. Sse nella cella C9 e nella cella D9 è presente "pluto" avrò come resoconto:

test_1          C9           pluto                1

test_1          D9           pluto                2

Non so se era la modifica a cui stavi facendo riferimento.

[albatros54Moderatore albatros54 Karma: 89 pts]

sostituisci il codice con quello che ti posto

Public Sub mRicerca(ByVal vRicerca As Variant, sPath As String)


    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim wk As Workbook
    Dim sh As Worksheet
    Dim shMe As Worksheet
    Dim lUltRiga As Long
    Dim c As Range
    Dim totale As Integer


    With Application
        .ScreenUpdating = False
    End With
    Set shMe = ThisWorkbook.Worksheets("Foglio1")
    totale = 0
    With shMe
        lUltRiga = .Range( _
                   "g" & .Rows.Count _
                   ).End(xlUp).Row
    End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)
    For Each objFile In objFolder.Files
        Select Case LCase(Right(objFile.Name, 4))
            Case ".xls", "xlsx", "xlsm"
                Set wk = Workbooks.Open(objFile.Path)
                For Each sh In wk.Worksheets
               lUltRiga = lUltRiga + 1
                    For Each c In sh.UsedRange
                    
                        If c.Value = vRicerca Then
                            totale = totale + 1
                        End if     
                        Next                       
                            shMe.Range("g" & lUltRiga).Value = objFile.Name
                            shMe.Range("h" & lUltRiga).Value = sh.Name
                            shMe.Range("i" & lUltRiga).Value = vRicerca
                            shMe.Range("j" & lUltRiga).Value = totale
                    
                    wk.Close
                    Set wk = Nothing
                Next
                totale = 0
        End Select
    Next
    With Application
        .ScreenUpdating = True
    End With

    Set c = Nothing
    Set wk = Nothing
    Set sh = Nothing
    Set shMe = Nothing
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing

End Sub

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[thunderPartecipante thunder]

così è davvero efficiente. Dato che alcuni file sono in .csv ho aggiunto

Case ".xls", "xlsx", "xlsm", ".csv"  

Quando apre il resoconto però da 0 come risultato di ricerca. Da cosa può dipendere?

[albatros54Moderatore albatros54 Karma: 89 pts]

Da cosa può dipendere?

è un file excel salvato con estensione csv?

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[thunderPartecipante thunder]

si è salvato in .csv. Vedendo i dati organizzati nelle celle credevo potesse leggerli direttamente.

Ti chiedo un altra cosa: vorrei che la macro venisse eseguita senza dover specificare il percorso cartella. Ho provato (erroneamente immagino) a sostituire il percorso con ThisWorkbook.Path   senza successo.

[albatros54Moderatore albatros54 Karma: 89 pts]

se i dati sono in un file excel, quindi nelle celle, e lo hai salvato come csv la macro deve funzionare.

se lo scenario è sempre lo stesso,basta inserire il percorso una volta ma se cambia sempre scenario lo devi modificare

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[thunderPartecipante thunder]

Confermo quanto da te detto. Va benissimo grazie.

Mi si pone un altro problema.In alcuni casi mi trovo a cercare un numero di valori tale che mi conviene quasi escludere quelli che non m'interessano per poterli contare. Posso continuare in questa discussione o ne apro un'altra?

Nel frattempo ti ringrazio per l'aiuto non scontato che mi hai dato.

[albatros54Moderatore albatros54 Karma: 89 pts]

se questa è risolta apri un'altra discussione

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[thunderPartecipante thunder]

non trovo il tasto di spunta per la risoluzione.. ho visto in una discussione precedente dove avevi allegato anche un file immagine ma a sx del tasto invia non c'è nulla

[albatros54Moderatore albatros54 Karma: 89 pts]

il tasto risolto si deve ancora implementare

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)

[Autore]

Articoli