Funzione VBA che totalizza dati di un foglio Excel 2007
Questo articolo segue I miei due interventi in materia:
(da leggere, prima di proseguire…)
Il linguaggio VBA + la libreria di oggetti Microsoft XMA v5 o v6 (aggiungerli con Strumenti > Riferimenti… ecc.) rende possibili molte elaborazioni sui dati OOXML di un file Excel 2007, in particolare su un sheet1.xml, sheet2.xml ecc, estratti da un qualche MioFoglio.xlsx o MioFoglio.xlsm in una ipotetica cartella C:\CartMioFoglio.
Questo articolo illustra come ottenere la totalizzazione dei valori di un foglio Excel (esterno). Ricordo ancora che occorrono I file xml seguenti:
Xl\worksheets\sheet1.xml
Xl\sharedStrings.xml
Prima funzione
Nell’esempio che segue le coordinate delle celle da totalizzare sono passate mediante un vettore, del tipo Array(“C1”,”C2”,…). In tal modo questa funzione si può usare anche in Word VBA e altrove.
Function SommaCelleVett(CartXml As String, VettRif) As Double
Dim DocXml As DOMDocument
Dim NodoXml As IXMLDOMNode
Set DocXml = New DOMDocument
DocXml.async = False
DocXml.Load ("" & CartXml & "\xl\worksheets\sheet1.xml")
Dim qStr As String 'Stringa di query XML
Dim Rif As String, i As Integer, Num As Double, S As Double
Dim EstNodoVal As Boolean, LungNodo As Integer
S = 0
For i = 0 To UBound(VettRif)
Rif = VettRif(i)
qStr = "//sheetData/row/" & "c[@r=" & "'" & Rif & "'" & "]/v"
Set NodoXml = DocXml.SelectSingleNode(qStr)
If Not NodoXml Is Nothing Then 'Evita nodi inesistenti
With NodoXml.parentNode
LungNodo = .Attributes.Length
EstNodoVal = .Attributes(LungNodo - 1).Text <> "s"
End With
If EstNodoVal Then
Num = Val(NodoXml.Text)
MsgBox Rif & " - " & Num 'Usato per debug, cancellare in seguito
S = S + Num
End If
End If
Next i
SumCellsArray = S
End Function
Ed ecco una possible routine di prova:
Sub ProvaSommaCelleVett()
VettRif = Array("C1", "C2", "G1", "C3", "C4", "C5")
MsgBox "Somma = " & SommaCelleVett("C:\CartMioFoglio", VettRif)
End Sub
Nota. Ho tribolato a trovare la stringa di query XPath qStr. La condizione @r relativa a un node di riferimento A1 è [@r=’A1’], ove il singolo apice è richiesto perché A1 sia accettato entro una stringa racchiusa tra doppie virgolette. Con una costante come A1 va tutto bene Ma se si passa un referimento variabile Rif, sintassi come [@r=Rif] o "[@r=" & Rif]" sono rigettate. La soluzione correttaI è quell ache, per comodità, riporto nuovamente qui sotto:
qStr = "//sheetData/row/" & "c[@r=" & "'" & Rif & "'" & "]/v"
Seconda funzione
Function SommaCelle(CartXml As String, Zona As Range) As Double
'Solo per Excel VBA
Dim DocXml As DOMDocument
Dim NodoXml As IXMLDOMNode
Set DocXml = New DOMDocument
DocXml.async = False
DocXml.Load ("" & CartXml & "\xl\worksheets\sheet1.xml")
Dim qStr As String
Dim Rif As String, i As Integer, Num As Double, S As Double
Dim Cella As Range
S = 0
For Each Cella In Zona
Rif = Cella.Address(False, False)
qStr = "//sheetData/row/" & "c[@r=" & "'" & Rif & "'" & "]/v"
Set NodoXml = DocXml.SelectSingleNode(qStr)
If Not NodoXml Is Nothing Then
With NodoXml.parentNode
LungNodo = .Attributes.Length
EstNodoVal = .Attributes(LungNodo - 1).Text <> "s"
End With
If EstNodoVal Then
Num = Val(NodoXml.Text)
MsgBox Rif & " - " & Num
S = S + Num
End If
End If
Next Cella
SumCells = S
End Function
Sub ProvaSommaCelle()
MsgBox "Somma = " & SommaCelle("C:\CartMioFoglio", Range("A1:F10"))
End Sub
Questa funzione si può usare solo con Excel perché solo Excel VBA supporta la funzione Range e la sua proprietà Address (che va usata con entrambi gli argomenti False per ottenere A1 anziché $A$1). Una funzione personale analoga con equivalente proprietà Address dovrebbe esser creata in ambienti VBA diversi (o VB, C#). La mia precedente soluzione provvede, forse rozzamente, mediante un vettore.
Utilizzo di SommaCelle come funzione personale sul foglio!
Una curiosità che sarà venuta in mente ai più avveduti (ma non è ditto): la funzione SommaCelle si può usare anche in un foglio di lavoro. Se, per esempio, inseriamo il testo C:\CartMioFoglio in A1, quindi la seguente funzione (personale Excel in B20 cell:
=SommaCelle($A$1,B1:B19)
In B20 si otterrà la somma relative alle celle B1:B19 del Foglio1 esterno.
E se si copia tale formula in C20:F20 appariranno tutti i vari totali, sempre su dati esterni. Si noterà che il ricalcolo è sorprendentemente rapido!
Una possibile applicazione è il confronto di somme di dati relative a intervalli analoghi di cartelle di lavoro consimili. In tal caso andranno inseriti testi opportuni relativi alle varie cartelle ospiti (in luogo di C:\CartMioFoglio dell’esempio) in altre celle come A1, ad esempio A2, A3 ecc.
?>
?>