La settimana scorsa, durante un corso di Excel per una azienda del Luganese, mi hanno raccontato una brutta storia. Uno dei lavori ricorrenti più lunghi, ingrati e noiosi affidati in azienda ad alcuni allievi era questo: data una tabella di ordini riempita dal cliente e simile a questa:
ottenere un elenco di dati simile a questo:
La prima domanda, ovviamente, è stata “Perché? Ma soprattutto, perché?” La dura risposta: “Perché il cliente vuole così, e il cliente ha sempre ragione”. Questo restringe molto il campo delle possibili soluzioni, ma almeno si può fare una bella macro. Siccome non c’è stato tempo durante il corso, mi ci sono divertito oggi e ho messo insieme una soluzione “quick & dirty” che farà storcere il naso a tutti i programmatori (io non lo sono), ma che funziona per qualsiasi tabella di qualsiasi dimensione, purché si parta con una cella attiva dentro la tabella da svolgere. Il file di esempio (47KB formato Excel 2003) è dalla tabella alla lista, e il codice è questo:
Sub Tabella_Elenco()
‘
‘ Prende una tabella da un foglio
‘ e la trasforma in un elenco in un altro foglio
‘
On Error Resume Next
Application.ScreenUpdating = False
Dim MioFoglio As Worksheet
Dim MiaTabella As Range
Dim Etichette As Range
Dim colcnt As Integer
Dim rowcnt As Integer
‘ Definisco le variabili e il foglio di destinazione
‘ con le etichette
Set MioFoglio = ActiveSheet
Set MiaTabella = ActiveSheet.Cells(1, 1).CurrentRegion
colcnt = MiaTabella.Columns.Count
rowcnt = MiaTabella.Rows.Count
Set Etichette = MiaTabella.Range(Cells(1, 2), Cells(1, colcnt))
N = 0
Sheets.Add.Name = “Destinazione”
With ActiveWorkbook.Names
.Add Name:=”Prodotto”, RefersTo:=”=Destinazione!A1″
.Add Name:=”Taglia”, RefersTo:=”=Destinazione!B1″
.Add Name:=”Quantità”, RefersTo:=”=Destinazione!C1″
End With
Range(“Prodotto”).FormulaR1C1 = “Prodotto”
Range(“Taglia”).FormulaR1C1 = “Taglia”
Range(“Quantità”).FormulaR1C1 = “Quantità”
‘ Copio e incollo in modo diverso per la prima riga
While N < rowcnt – 1
Application.CutCopyMode = False
MiaTabella.Cells(N + 2, 1).Copy
Application.Goto Reference:=”Prodotto”
If N = 0 Then
Range(“Prodotto”).Offset(1, 0).Range(“A1”).Select
Else
Range(“Prodotto”).End(xlDown).Offset(1, 0).Range(“A1″).Select
End If
Selection.Resize(Selection.Rows.Count + colcnt – 2, Selection.Columns.Count).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Etichette.Copy
Application.Goto Reference:=”Taglia”
If N = 0 Then
Range(“Taglia”).Offset(1, 0).Range(“A1”).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Else
Range(“Taglia”).End(xlDown).Select
ActiveCell.Offset(1, 0).Range(“A1″).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End If
Application.CutCopyMode = False
MioFoglio.Select
MiaTabella.Range(Cells(N + 2, 2), Cells(N + 2, colcnt)).Copy
Application.Goto Reference:=”Quantità”
If N = 0 Then
Range(“Quantità”).Offset(1, 0).Range(“A1”).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Else
Range(“Quantità”).End(xlDown).Select
ActiveCell.Offset(1, 0).Range(“A1”).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End If
N = N + 1
Wend
Application.CutCopyMode = False
Range(“A1”).Select
Application.ScreenUpdating = True
End Sub
Buon divertimento. Molto volentieri accetto critiche, pomodori e suggerimenti.
