Nonostante l'abbondanza di opzioni, provo anche io a dare un contributo con una Function ad hoc, che corrisponde al sequente codice:
- Codice: Seleziona tutto
Function myResumeF(ByRef iRan As Range) As Variant
Dim oArr(), I As Long, J As Long, oInd As Long
Dim fRows As Long, iRows As Long
Dim myMatch
'
iRows = iRan.Rows.Count * iRan.Columns.Count / 2
fRows = Application.Parent.Caller.Rows.Count
'
ReDim oArr(1 To 2, 1 To iRows)
For I = 1 To iRan.Rows.Count
For J = 1 To iRan.Columns.Count Step 2
If iRan.Cells(I, J) <> "" Then
myMatch = Application.Match(iRan.Cells(I, J), Application.WorksheetFunction.Index(oArr, 1, 0), False)
If IsError(myMatch) Then
oInd = oInd + 1
oArr(1, oInd) = iRan.Cells(I, J)
oArr(2, oInd) = iRan.Cells(I, J + 1)
Else
oArr(2, myMatch) = oArr(2, myMatch) + iRan.Cells(I, J + 1)
End If
End If
Next J
Next I
If oInd >= fRows Then
ReDim Preserve oArr(1 To 2, 1 To oInd)
Else
ReDim Preserve oArr(1 To 2, 1 To fRows)
End If
If oInd > fRows Then
oArr(1, fRows) = "+" & (oInd - fRows)
ElseIf oInd < fRows Then
For I = oInd + 1 To fRows
oArr(1, I) = "--"
oArr(2, I) = "--"
Next I
End If
myResumeF = Application.WorksheetFunction.Transpose(oArr)
End Function
Il codice va messo in un Modulo standard del vba. A questo punto sul foglio excel e' disponibile la funzione myResumeF
La sintassi da usare e'
myResumeF(RangeDati)
RangeDati puo' includere anche righe vuote, che verranno ignorate
Nell'ipotesi che i dati siano in colonna A (descrizione, B (qt), C (descrizione), D (qt):
- Codice: Seleziona tutto
=myResumef(A2:D20)
La formula va immessa sotto forma di "formula a matrice", tenendo presente che restituisce N righe x 2 colonne. Quindi:
-selezionare un'area di N righe e 2 colonne
-inserire la formula nella barra della formula
-confermare la formula con Contr-Maiusc-Enter, non il solo Enter
RangeDati non e' obbligatorio che sia di 4 colonne, l'importante e' che l'intervallo comprenda "coppie di colonne" contigue; quindi sono valide formule tipo
- Codice: Seleziona tutto
=myResumef(A2:B30) '1 sola coppia, A-B
=myResumef(B1:E30) '2 coppie, B-C e D-E
=myResumef(A2:F30) '3 coppie: A-B, C-D, E-F
Se le righe non sono sufficienti per i risultati che devono essere visualizzati, allora in colonna 1 dell'ultima riga comparira' la scritta "+X", che indica che bisogna aggiungere ulteriori X righe alla formula. A questo scopo:
-selezionare l'area corrente dei risultati
-estendere la selezione per ulteriori "X" righe
-premere F2 (edit formula), confermare con Contr-Maiusc-Enter
NB: questo e' il modo naturale di lavorare con le formule a matrice
Se la formula si estendesse su piu' righe rispetto ai risultati restituiti, le righe superflue verranno compilate con "--"; questa scelta e' stata preferita al lasciare le celle vuote per rendere evidente il fatto che la formula occupa quel tot di celle, ma comunque puo' essere modificata nel codice.
Un saluto a tutti
Registrazione
