Newsgroup: it.comp.lang.visual-basic
Titolo: Somma.se con fogli multipli e vba

Ciao a tutti, vi chiedo un aiuto visto che ho trovato una possibile 
soluzione al mio problema ma non riesco ad applicarla perch� non conosco 
VBA.
Ho un file in excel in cui ci sono dodici fogli nominati Cap1, Cap2, Cap3 
ecc. fino a Cap12
Nella colonna C di ognuno di questi fogli inserisco dei valori, per esempio 
APP, QE..che si possono anche ripetere all'interno dello stesso foglio,  e 
nella colonna L di ogni foglio, in corrispondenza di APP. QE. ho un importo.
Vorrei creare un nuovo foglio Riepilogo che mi restituisca, in 
corrispondenza di ogni voce APP, QE.. la somma di tutti gli importi di tutti 
i fogli
Ho trovato questa procedura:
Function my3DSum(CheckCell As String, CompString As String, SumCell As _
String, ParamArray SheetList() As Variant)
Dim mySheets As Sheets, myWs As Worksheet
Dim myRangeC As Range, myRangeS As Range
Dim rTemp As Range
Dim iRow As Integer
Dim lTot As Long
Set mySheets = Sheets(SheetList)
Set myRangeC = Range(CheckCell)
Set myRangeS = Range(SumCell)
    For Each myWs In mySheets
        Set myRangeC = myWs.Range(CheckCell)
        Set myRangeS = myWs.Range(SumCell)
            For Each rTemp In myRangeC
                If rTemp.Value = CompString Then
                    iRow = rTemp.Row
                    lTot = lTot + myRangeS.Cells(iRow, 1).Value
                End If
            Next rTemp
    Next myWs
my3DSum = lTot
End Function
CHECKCELL : stringa che rappresenta l'intervallo di celle che deve
essere testato
COMPSTRING : valore che deve essere confrontato con le celle presenti
nell'intervallo CHECKCELL
SUMCELL : stringa che rappresenta l'intervallo di celle che deve essere
sommato
SHEETLIST : elenco dei fogli in cui risiede l'intervallo specificato nel
CHECKCELL
ma non so come modificare i parametri per fare in modo che si adatti al mio 
foglio di excel, qualcuno pu� aiutarmi?
Ho capito che a checkcell corrisponde la colonna C, a compstring la cella 
del mio foglio riepilogo che contiene la voce da sommare, per esempio APP 
(supponiamo che sia A1)
Sumcell � la colonna L e sheet list � la lista dei fogli da Cap1 a Cap12 ma 
non so come "dirlo" alla funzione sopra
Grazie comunque a tutti per l'attenzione

 non so come "dirlo" alla funzione sopra
Scusa, ma se non capisci quello che la funzione fa, o comunque non riesci a
trovare quello che dovrebbe fare, non � detto che la funzione vada bene per
quello che devi fare.
I subtotali di excel, se ho capito bene, fanno quello che chiedi, per ogni
singolo foglio.
Quella funzione invece ti d� un totale per una singola voce.


<cut>
Se(se) ho capito quello che vuoi.
I nomi dei foglio qui sono Foglio1/2/3.
Sostituiscili e implementa l'insieme
shArray con i nomi dei
tuoi fogli.
Public Function f(ByVal v As Variant) As Double
    Dim shArray As Sheets
    Dim sh As Worksheet
    Dim lUltRiga As Long
    Dim rngTesto As Range
    Dim rngDati As Range
    Dim sFunzione As String
    f = 0
    Set shArray = Worksheets( _
        Array("Foglio1", _
        "Foglio2", _
        "Foglio3"))
    For Each sh In shArray
        With sh
            lUltRiga = .Range( _
                "C" & .Rows.Count _
                ).End(xlUp).Row
            Set rngTesto = .Range( _
                "C1:C" & lUltRiga)
            Set rngDati = .Range( _
                "L1:L" & lUltRiga)
            sFunzione = "=SUMIF(" & _
                .Name & "!" & rngTesto.Address & "," _
                & """" & v & """" & "," _
                & .Name & "!" & rngDati.Address & ")"
            f = f + Evaluate(sFunzione)
        End With
    Next
    Set rngTesto = Nothing
    Set rngDati = Nothing
    Set sh = Nothing
    Set shArray = Nothing
End Function
Nel foglio dove vuoi i totali deve esserci un elenco con
le voci univoche(es. in colonna A).
Quindi, nel foglio di riepilogo:
        A
1    APP.
2    QE.
3    Ecc.
In b1: =f(A1)
Trascina verso il basso.
-- 
---------------------------
Mauro Gamberini
http://www.riolab.org/
http://blog.maurogsc.eu/

<cut>
Con il codice qui sotto, invece,
lanciando la Sub m(),
ti verranno messi in colonna A
del foglio Riepilogo i valori della
colonna C(in modo univoco) e
a fianco in colonna B le somme dei
relativi importi.
La funzione rimane fruibile direttamente
dalle celle(per questo c'� ridondanza
nelle dichiarazioni delle variabili).
Fai due prove perch� l'ho testata
poco. Non dovrebbero(non dovrebbero)
esserci errori se in colonna L non hai dati
numerici. Potrebbero esserci problemi
se ci fossero date(ma si potrebbe rimediare).
Public Function f(ByVal rng As Variant) As Double
    Dim shArray As Sheets
    Dim sh As Worksheet
    Dim lUltRiga As Long
    Dim rngTesto As Range
    Dim rngDati As Range
    Dim sFunzione As String
    f = 0
    Set shArray = Worksheets( _
        Array("Foglio1", _
        "Foglio2", _
        "Foglio3"))
    For Each sh In shArray
        With sh
            lUltRiga = .Range( _
                "C" & .Rows.Count _
                ).End(xlUp).Row
            Set rngTesto = .Range( _
                "C1:C" & lUltRiga)
            Set rngDati = .Range( _
                "L1:L" & lUltRiga)
            sFunzione = "=SUMIF(" & _
                .Name & "!" & rngTesto.Address & "," _
                & """" & rng.Value & """" & "," _
                & .Name & "!" & rngDati.Address & ")"
            f = f + Evaluate(sFunzione)
        End With
    Next
    Set rngTesto = Nothing
    Set rngDati = Nothing
    Set sh = Nothing
    Set shArray = Nothing
End Function
Public Sub m()
    Dim shArray As Sheets
    Dim sh As Worksheet
    Dim shRiepilogo As Worksheet
    Dim c As Range
    Dim vItem As Variant
    Dim lUltRiga As Long
    Dim rngTesto As Range
    Dim colColl As Collection
    Dim lRiga As Long
    Set shRiepilogo = Worksheets("Riepilogo")
    Set shArray = Worksheets( _
        Array("Foglio1", _
        "Foglio2", _
        "Foglio3"))
    Set colColl = New Collection
    lRiga = 1
On Error Resume Next
    For Each sh In shArray
        With sh
            lUltRiga = .Range( _
                "C" & .Rows.Count _
                ).End(xlUp).Row
            Set rngTesto = .Range( _
                "C1:C" & lUltRiga)
            For Each c In rngTesto
                colColl.Add c.Value, _
                    CStr(c.Value)
            Next
        End With
    Next
    With shRiepilogo
        For Each vItem In colColl
            shRiepilogo.Range("A" & lRiga).Value = _
                vItem
            shRiepilogo.Range("B" & lRiga).Value = _
                f(.Range("A" & lRiga))
            lRiga = lRiga + 1
        Next
    End With
    Set c = Nothing
    Set colColl = Nothing
    Set rngTesto = Nothing
    Set sh = Nothing
    Set shRiepilogo = Nothing
    Set shArray = Nothing
    Exit Sub
End Sub



E' quello che voglio ottenere 


Hai capito esattamente quello che volevo
Ho inserito la funzione nel foglio excel e fa quello che volevo, ti 
ringrazio molto per l'aiuto.
D. 

        "Foglio3", "Foglio4"))
questo non succede perch� non ho ho specificato nell'intervallo il foglio5
C'� un sistema per farlo aggiornare automaticamente? 

 E' quello che voglio ottenere
Tu vuoi un totale di tutte le voci raggruppato per voce, non di una singola
voce. Quindi o chiamavi quella funzione #n volte, oppure nisba.
Comunque ho visto che hai risolto.

 C'� un sistema per farlo aggiornare automaticamente?
Puoi prendere tutti i fogli tranne quello che si chiama in un certo modo, o
l'ultimo  o quello che vuoi.
Sei sicura che poi non dia problemi per�?
Con questo scorri i fogli e relativo nome e gli aggiungi all'array degli
sheets.
For NN = 1 To .Sheets.Count
    If ActiveWorkbook.Sheets(NN).Name = .... Then
         .....
    End If
Next NN
L'ho preso da codice vb6 ma dovrebbe essere la stessa sintassi.


Puoi andare *per esclusione* come ti ha consigliato
Andrea. Visto dal vb Excel suona pi� o meno
cos�:
Public Function f(ByVal v As Variant) As Double
    Dim sh As Worksheet
    Dim lUltRiga As Long
    Dim rngTesto As Range
    Dim rngDati As Range
    Dim sFunzione As String
    f = 0
    For Each sh In Worksheets
        select case 
sh.name
            case = "riepilogo", "copertina"
            case else
        With sh
            lUltRiga = .Range( _
                "C" & .Rows.Count _
                ).End(xlUp).Row
            Set rngTesto = .Range( _
                "C1:C" & lUltRiga)
            Set rngDati = .Range( _
                "L1:L" & lUltRiga)
            sFunzione = "=SUMIF(" & _
                .Name & "!" & rngTesto.Address & "," _
                & """" & v & """" & "," _
                & .Name & "!" & rngDati.Address & ")"
            f = f + Evaluate(sFunzione)
        End With
        end select
    Next
    Set rngTesto = Nothing
    Set rngDati = Nothing
    Set sh = Nothing
End Function
Ho scritto qui in O.E. .
Controlla e fai qualche prova.
Grazie.



Scusa Andrea, precisazione non richiesta.
Sheets restituisce l'insieme di tutti i fogli,
compresi quelli che contengono i grafici.
Worksheets, solo i fogli di lavoro.
Prova ad aggiungere un foglio con un grafico
e lancia questa:
Public Sub m()
    MsgBox "Worksheets: " & Worksheets.Count _
        & vbNewLine & "Sheets: " & Sheets.Count
End Sub


 Worksheets, solo i fogli di lavoro.
In effetti quel ciclo serviva semplicemente in un'esportazione Ado2Excel
trovata mi pare sul sito comune.
In quel caso � giusto che scansionasse tutti i fogli, dato che era per non
dare un nome gi� presente ad un foglio.
Comunque me la segno, se mi dovesse servire.
Tnx


Ciao!
ho provato a fare copia e incolla di questa funzione ma non va, mi 
restituisce subito l'errore VALORE! quindi non ho nemmeno provato ad 
inserire un nuovo foglio di lavoro.
C'� qualche parte che devo adattare al mio file? 

 C'� qualche parte che devo adattare al mio file?
La funzione richiede un parametro.
Restando all'esempio postato, se richiamata
da una cella:
B1=f(A1)
o, se richiamata da codice:
Dim d As Double
d = f("APP:")


<cut>
Inoltre, aggiungi questa riga:
    Application.Volatile
Prima di
    f = 0
Non dovrai fare il refresh della
funzione se immetti nuovi dati.


<cut>
Astraendola un po', si potrebbe modificare
cos�:
Public Function f(ByVal v As Variant, _
    ByVal sColTesto As String, _
    ByVal sColDati As String) As Double
    Dim sh As Worksheet
    Dim lUltRiga As Long
    Dim rngTesto As Range
    Dim rngDati As Range
    Dim sFunzione As String
    Application.Volatile
    f = 0
    For Each sh In Worksheets
        Select Case sh.Name
            Case Is = "riepilogo", "copertina"
            Case Else
                With sh
                    lUltRiga = .Range( _
                        sColTesto & .Rows.Count _
                        ).End(xlUp).Row
                    Set rngTesto = .Range( _
                        sColTesto & "1:" & _
                        sColTesto & lUltRiga)
                    Set rngDati = .Range( _
                        sColDati & "1:" & _
                        sColDati & lUltRiga)
                    sFunzione = "=SUMIF(" & _
                        .Name & "!" & _
                        rngTesto.Address & "," _
                        & """" & v & """" & "," _
                        & .Name & "!" & _
                        rngDati.Address & ")"
                    f = f + Evaluate(sFunzione)
                End With
        End Select
    Next
    Set rngTesto = Nothing
    Set rngDati = Nothing
    Set sh = Nothing
End Function
A questo punto non sei pi� legata alle colonne
C e L, ma potresti avere i dati in qualsiasi colonna,
passando alla funzione anche i rispettivi riferimenti.
Esempio per cella:
B1: =f(A1;"C";"L")
Esempio per codice:
Public Sub m()
    MsgBox f("APP.", "C", "L")
End Sub
Ti ricordo inoltre che esiste un apposito newsgroup
per Excel ed il suo vb:
microsoft.public.it.office.excel
forse pi� indicato per questo tipo di
discussioni.



non lo sapevo... grazie per l'informazione e grazie per l'aiuto.
Daniela 


;-)
