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

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Tanto per partecipare, stante la validità del lavoro di albatros, posto la mia idea che tanto male non fa 🙂

Option Explicit

Sub subtotals()
Dim wbk As Workbook, sh As Worksheet
Dim f As Object
Dim mnth As Range

Set wbk = ThisWorkbook
Set sh = ThisWorkbook.Sheets("ECA")

For Each f In CreateObject("Scripting.FileSystemObject").getfolder(ThisWorkbook.Path & "\excelvba test\").Files

Set wbk = Workbooks.Open(f)

wbk.Sheets("LV").Activate

For Each mnth In sh.Range("C5:C16")

mnth.Offset(, 1) = WorksheetFunction.CountIfs(Range("AB3:AB500"), "YES", Range("AE3:AE500"), mnth)

Next

wbk.Close False
Next

Set f = Nothing

MsgBox "Done"
End Sub

(Come fai ad inserire il codice in quel bel formato?)

Provo anche ad allegare il mio file di esempio.

[Espresso90Partecipante Espresso90]

<em class="bbp-the-quote-cite">albatros54 wrote:questo fa quello che hai chiesto

Ho riscontrato un paio di errori:

1- non mi aggiorna tutta la tabella (D5:D16)

2- i valori che mi assegna sono 0 nelle celle D5, D6, D7, D8

Pensi che possa aver sbagliato qualcosa?

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Allego un file di esempio, TEST-1.xlsm, per prova. Condizioni:

- questo file è quello che conterrà i totali;

- nella directory dove viene posto, va creata la cartella "EXCELVBA TEST" dove inserire tutti i file che conterranno i dati da conteggiare. Non offendo la vostra intelligenza indicandovi la riga da modificare per cambiare questo path 🙂

 

Allegati:

You must be logged in to view attached files.

[Espresso90Partecipante Espresso90]

<em class="bbp-the-quote-cite">vecchio frac wrote:Tanto per partecipare, stante la validità del lavoro di albatros, posto la mia idea che tanto male non fa

Vecchio frac ho provato e mi dice "Impossibile trovare il percorso" sapresti darmi un suggerimento su dove fare la modifica?

[albatros54Moderatore albatros54 Karma: 89 pts]

VF è piu ristretto di me nello stilare i codici 😉

 

 

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]

Hai letto il mio ultimo post? hai creato la cartella di test dove depositare i file da verificare? in alternativa, tieni la cartella originale, ma modifica la riga di codice che apre i file interessati:

CreateObject("Scripting.FileSystemObject").getfolder(ThisWorkbook.Path & "\excelvba test\").Files

Il codice non è complicato e fa abbastanza bene quello che promette. Certo non ho dati di riscontro ma poichè hai già detto che per JAN --> YES  ==> 3 sono fiducioso :).

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Gioacchino insegnami a formattare il codice come fai tu 🙂

[albatros54Moderatore albatros54 Karma: 89 pts]

vecchio frac wrote:(Come fai ad inserire il codice in quel bel formato?)

seleziona la scheda visuale click sulle parentei graffe è si apre l'editor del codice, dove puoi incollare il tuo codice 😉

 

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]

albatros54 wrote:seleziona la scheda visuale click sulle parentei graffe

Io invece prima selezionavo il testo e poi premevo il pulsante cui ti riferisci.

Grazie... Beata gioventù 🙂

[albatros54Moderatore albatros54 Karma: 89 pts]

vecchio frac wrote:Grazie... Beata gioventù

guarda che il numero sull'avatar non è il mio numero di scarpe e nemmeno l'eta 😉  

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">vecchio frac wrote:

Hai letto il mio ultimo post? hai creato la cartella di test dove depositare i file da verificare? in alternativa, tieni la cartella originale, ma modifica la riga di codice che apre i file interessati:

Ok, ho risolto il problema del percorso del file, adesso ho un altro problema (scusami ma sono alle prime armi)

Quando arrivo alla riga di codice : "wbk.Sheets("LV").Activate"

durante il debug mi dice: Variabile oggetto o variabile del blocco with non impostata

Consigli ?

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Espresso90 wrote:Consigli ?

Sì. Salva il foglio di lavoro prima di lanciare la macro.

Inoltre è possibile che il foglio "LV" non esista in uno o più file che vengono via via aperti.

[Espresso90Partecipante Espresso90]

Ok, grazie mille dell' aiuto ad entrambi.

[Espresso90Partecipante Espresso90]

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

<em class="bbp-the-quote-cite">Espresso90 wrote:Consigli ?

Scusatemi ma non sono riuscito a trovare la soluzione che desideravo.

In allegato 2 file che rispecchiano il lavoro che devo svolgere.

Come dicevo ieri nel foglio di lavoro yyy nella cella D5 devo calcolare tramite codice vba quella che scritta in formula è

( CONTA.PIÙ.SE(LV!$AE$3:$AE$500;GRAPHIC!$C5;LV!$AB$3:$AB$500;Foglio1!$A$10)

)

Scusatemi se mi ripeto ma cerco di essere il più chiaro possibile, va fatto un confronto tra quante volte è contenuto JAN (Foglio xxx --> Graphic --> cella C5) e quante volte è contenuto YES (Foglio xxx --> Foglio1 --> cella A1o) e il valore va visualizzato in D5 del foglio yyy.

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Se ho capito,ho apportate alcune modifiche al codice che ti ho postato in precedenza(quello di VF è troppo semplice 😀 ) provalo

`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 totale1 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 = ThisWorkbook.Path    
    


    '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
               wk.Sheets("LV").Activate
                    'ciclo le celle dei fogli
                    totale1 = 0
                    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

                            totale = totale + 1
                        End If



                        If c.Value = clrngshme Then
                            If c.Offset(0, -2) = "YES" Then
                                totale1 = totale1 + 1
                            End If

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

            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 )

[Espresso90Partecipante Espresso90]

<em class="bbp-the-quote-cite">albatros54 wrote:questo fa quello che hai chiesto

Ho provato ma finisco in un loop di finestre di salvataggio che si continuano ad aprire senza risultato finale.

Penso che non funzioni

[albatros54Moderatore albatros54 Karma: 89 pts]

ti allego i file dove ho fatto le prove, crea ina dir "TEST" è metti i file li dentro e poi dal fileyyy.xlsm lanci la macro

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 )

Allegati:

You must be logged in to view attached files.

[albatros54Moderatore albatros54 Karma: 89 pts]

Ho prova questo codice che ti ha postato VF,dove ho aggiunto una riga di codice

Sub subtotals()
    Dim wbk As Workbook, sh As Worksheet
    Dim f As Object
    Dim mnth As Range

    Set wbk = ThisWorkbook
    Set sh = ThisWorkbook.Sheets("ECA")

    For Each f In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files

        Set wbk = Workbooks.Open(f)

        wbk.Sheets("LV").Activate

        For Each mnth In sh.Range("C5:C16")

            mnth.Offset(, 1) = WorksheetFunction.CountIfs(Range("Ae3:AE500"), mnth)
            mnth.Offset(, 2) = WorksheetFunction.CountIfs(Range("Ac3:Ac500"), "YES", Range("AE3:AE500"), mnth)
        Next

        wbk.Close False
    Next

    Set f = Nothing

    MsgBox "Done"
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 )

[Espresso90Partecipante Espresso90]

<em class="bbp-the-quote-cite">albatros54 wrote:Ho prova questo codice che ti ha postato VF,dove ho aggiunto una riga di codice

Ho visualizzato i file di test che hai allegato, effettivamente funziona proprio bene, ma purtroppo quando provo ad inserire questo codice all' interno del mio programma questo mi da degli errori.

Per quanto riguarda il secondo codice che hai presentato mi da errore alla riga "Set wbk = Workbooks.Open(f)" --> formato di file non valido, probabilmente mi punta ad un file errato.

[albatros54Moderatore albatros54 Karma: 89 pts]

Espresso90 wrote:Ho visualizzato i file di test che hai allegato, effettivamente funziona proprio bene, ma purtroppo quando provo ad inserire questo codice all' interno del mio programma questo mi da degli errori.

prova ad inserire in una dir solamente  il file che contiene la macro e il file dove fara la ricerca

Espresso90 wrote:mi da errore alla riga "Set wbk = Workbooks.Open(f)" -->

che errore ti da? forse il path è sbagliato?

 

 

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:Ho visualizzato i file di test che hai allegato, effettivamente funziona proprio bene, ma purtroppo quando provo ad inserire questo codice all' interno del mio programma questo mi da degli errori.

Grazie funziona. 

[Autore]

Articoli