Visualizzare in una cella i valori contenuti in un range di celle

[Espresso90Partecipante Espresso90]

Ciao a tutti, sono nuovo nel forum e mi scuso in partenza nel caso commettessi qualche errore.

Tramite Macro dovrei visualizzare in una cella di un foglio esterno quante volte compare la scritta JAN (contenuta nella cella c5 del foglio "GRAPHIC") nell' intervallo AE3:AE500 e contemporaneamente quante volte compare la scritta YES nel range AB3:AB500 del foglio "Foglio1" .

 

[albatros54Moderatore albatros54 Karma: 89 pts]

Espresso90 wrote:Tramite Macro dovrei visualizzare in una cella di un foglio esterno

quindi in un'altro workbook, o in fogli diversi dello stesso workbook?

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Espresso90Partecipante Espresso90]

In un altro workBook

[albatros54Moderatore albatros54 Karma: 89 pts]

 

Espresso90 wrote:In un altro workBook

Che si trova nella stessa Dir da dove c'è il file di Excel con la macro che tu esegui e il workbook è aperto?

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Espresso90Partecipante Espresso90]

Si albatros

[albatros54Moderatore albatros54 Karma: 89 pts]

cerca di inserire i file, senza dati sensibili, in modo da avero la scenario

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Espresso90Partecipante Espresso90]

Certo, considera che il foglio ECA all' interno del file test teoricamente è in un altro WorkBook, mentre foglio1 e il foglio "LV" appartengono allo stesso workbook.

L' obiettivo è quello di completare le celle del foglio eca tramite macro. La macro dovrebbe fare un confronto nel range AE3:AE500 del foglio LV dove vi è la parola JAN e contemporaneamente dove compare YES nel range AB3:AB500 del foglio1.

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Espresso90 wrote: compare YES nel range AB3:AB500 del foglio1.

Nel  foglio1 non vedo  nessun range che dici tua, la parola yes si trova nella cella(10,1)

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Espresso90Partecipante Espresso90]

Si scusami ho sbagliato il range è sempre nel foglio LV e va da AB3:AB500.

[albatros54Moderatore albatros54 Karma: 89 pts]

quindi da quello che ho capito: debbo contare quante volte trovo la parola "jan" e quanto volte trovo la parola "yes" , e questi valori li debbo inserire nel foglio("ECA") nelle celle ...?

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Espresso90Partecipante Espresso90]

Praticamente la macro dovrebbe fare in automatico il calcolo.
Nella cella D5 del foglio ECA dovrà essere visualizzato il numero delle volte che compare JAN nell' intervallo AE3:AE500 del foglio LV però deve contare soltanto le volte in cui contemporaneamente compare YES nell' intervallo AB3:AB500 del foglio LV.

[albatros54Moderatore albatros54 Karma: 89 pts]

incolla il codice che ti posto in un modulo del file che contiene il foglio"ECA", per funzionare al meglio, i file di Excel debbono trovarsi nella stessa dir

Option Explicit

Public Sub mRicerca()

'dichiaro le variabili
    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 sPath As String
    Dim vRicerca As Variant
    Dim totale As Integer
    'impedisco lo sfarfallio del monitor
    With Application
        .ScreenUpdating = False
    End With
    'metto un riferimento al Foglio1
    'di questa cartella di Excel
    Set shMe = ThisWorkbook.Worksheets("ECA")
    sPath = "K:\excel\cercaneifiles\Cartella" ' <===== DA CAMBIARE
    vRicerca = InputBox("dato")


    'creo duo oggetti
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)

    'ciclo i files della cartella
    For Each objFile In objFolder.Files
        'se sono files di Excel
        If Left(objFile.Name, 1) <> "~" And (Right(objFile.Name, Len(objFile.Name) - InStrRev(objFile.Name, ".")) Like "*xl*") And (objFile.Name <> ThisWorkbook.Name) Then
            'li apro
            Set wk = Workbooks.Open(objFile.Path)
            'ciclo i fogli
            For Each sh In wk.Worksheets
                'ciclo le celle dei fogli
                For Each c In sh.Range("ae3:ae500")
                    'se il contenuto della cella
                    'corrisponde al valore cercato
                    If c.Value = vRicerca Then
                        If c.Offset(0, -3) = "YES" Then
                            totale = totale + 1
                        End If

                    End If
                Next
                shMe.Range("D5") = totale
                'chiudo il file
                wk.Close
                'Set a Nothing della variabile oggetto
                Set wk = Nothing
            Next
        End If
    Next

    'ripristino l'update del monitor
    With Application
        .ScreenUpdating = True
    End With

    'Set a Nothing delle variabili oggetto
    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)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Il file di test mi dà problemi nei collegamenti. Se interrompo i collegamenti vedo valori di errore. C'è qualche possibilità di avere uno scenario corretto? e magari anche con l'indicazione di quale sarebbe un possibile risultato atteso (cioè, quanti valori di ritorno ti aspetti per JAN e YES)?

[Espresso90Partecipante Espresso90]

Ciao vecchio frac, provo ad allegarti nuovamente un file di test sperando che non ti dia errori.

Il risultato per le cella D5 corrispondente a JAN dovrebbe essere 3.

Allegati:

You must be logged in to view attached files.

[Espresso90Partecipante Espresso90]

Albatros, ho provato il tuo codice, funziona in parte ma mi va in crash excel dopo alcuni test. Riesci a fornire un codice un po più smart?

Grazie comunque dell' aiuto.

[albatros54Moderatore albatros54 Karma: 89 pts]

Scusate, vi allego i due file cosi come li ho concepiti io, è il tutto funziona, naturalmente i file devono esere nella stessa dir e bisogna aprire solo ,il file "Cercaneifiles"

 

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Comunque io pensavo a una cosa più semplice.

Tipo una formuletta:

=CONTA.PIÙ.SE(AB3:AB500;"YES";AE3:AE500;"JAN")

Magari un piccolo ciclo For nel foglio ECA per ogni riga intestata JAN, FEB ecc. che cerchi tali intestazioni nel range AE del foglio LV e aggreghi i dati di conseguenza utilizzando la formule suddetta (probabilmente non è più veloce ma il codice è più compatto).

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Che poi immagino che l'array "JAN" --> "DEC" sia fisso e immutabile.

[albatros54Moderatore albatros54 Karma: 89 pts]

vecchio frac wrote:Tipo una formuletta: =CONTA.PIÙ.SE(AB3:AB500;"YES";AE3:AE500;"JAN")

da ricordare che questi valori li deve ricercare in un file estero al file che contiene la formula  

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)Sempre il mare, uomo libero, amerai! ( Charles Baudelaire )

[Espresso90Partecipante Espresso90]

Si dovrebbe essere fisso e possibilmente automatico senza la necessità di dover inserire il dato da cercare, come fatto da Albatros.

[albatros54Moderatore albatros54 Karma: 89 pts]

Espresso90 wrote:dover inserire il dato da cercare, come fatto da Albatros.

questo non è un problema 🙂

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Espresso90Partecipante Espresso90]

<em class="bbp-the-quote-cite">albatros54 wrote:

<em class="bbp-the-quote-cite">Espresso90 wrote:dover inserire il dato da cercare, come fatto da Albatros.

Più che altro ho notato che mi viene chiesto più volte di salvare, ce modo di avere un codice che faccia in automatico i passaggi?

Mi spiego meglio, un codice che una volta lanciata la macro mi completi la tabella JAN--> DEC in automatico?

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

albatros54 wrote:da ricordare che questi valori li deve ricercare in un file estero al file

Bè certo ma tengo salva la tua soluzione di ciclare sui file della cartella che contiene i file da esaminare. Io evitavo solo il cerca & trova all'interno del For, sostituendolo con la formuletta indicata. Cioè apro il file in cui inserire i subtotali, avvio la macro con cui in un ciclo For apro ogni file che contiene i dati, ricavo il subototale con la formuletta, aggiorno il file dei subtotali, fine.

[Espresso90Partecipante Espresso90]

<em class="bbp-the-quote-cite">vecchio frac wrote:

<em class="bbp-the-quote-cite">albatros54 wrote:da ricordare che questi valori li deve ricercare in un file estero al file

Scusa l' ignoranza ma tradotto in codice come risulterebbe?

[albatros54Moderatore albatros54 Karma: 89 pts]

questo fa quello che hai chiesto

`Option Explicit

Public Sub mRicerca()

'dichiaro le variabili
    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 sPath As String
    Dim vRicerca As Variant
    Dim totale As Integer
    Dim rngshme As Range
    Dim clrngshme As Range
    Dim indirizzo As String
    'impedisco lo sfarfallio del monitor
    With Application
        .ScreenUpdating = False
    End With
    'metto un riferimento al Foglio1
    'di questa cartella di Excel
    Set shMe = ThisWorkbook.Worksheets("ECA")
    sPath = "K:\manuali\excel\cercaneifiles\Cartella"    ' <===== DA CAMBIARE
    'vRicerca = InputBox("dato")


    'creo duo oggetti
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)
    Set rngshme = Range("C5:C16")
    'ciclo i files della cartella
    For Each clrngshme In rngshme
        For Each objFile In objFolder.Files
            'se sono files di Excel
            If Left(objFile.Name, 1) <> "~" And (Right(objFile.Name, Len(objFile.Name) - InStrRev(objFile.Name, ".")) Like "*xl*") And (objFile.Name <> ThisWorkbook.Name) Then
                'li apro
                Set wk = Workbooks.Open(objFile.Path)
                'ciclo i fogli
                For Each sh In wk.Worksheets
                    'ciclo le celle dei fogli

                    totale = 0
                    indirizzo = clrngshme.Address
                    For Each c In sh.Range("ae3:ae500")
                        'se il contenuto della cella
                        'corrisponde al valore cercato
                        If c.Value = clrngshme Then
                            If c.Offset(0, -3) = "YES" Then
                                totale = totale + 1
                            End If

                        End If
                    Next
                    shMe.Range(indirizzo).Offset(0, 1) = totale
                    'chiudo il file
                    wk.Close
                    'Set a Nothing della variabile oggetto
                    Set wk = Nothing
                Next

            End If
        Next
    Next
    'ripristino l'update del monitor
    With Application
        .ScreenUpdating = True
    End With

    'Set a Nothing delle variabili oggetto
    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)Sempre il mare, uomo libero, amerai! ( Charles Baudelaire )

[Autore]

Articoli