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.

Tags: Exce | l macro | tabella | elenco

Leggi tutto