Trasformare matrice in tabella

[pdicinoPartecipante pdicino]

Buongiorno a tutti,

è il mio primo post e spero possa essere utile anche ad altri di voi.

Vin allegato un file (con dati fittizi) con una macro che partendo dal foglio in verde che contiene una matrice, crea una tabella e ne filtra i soli campi valorizzati (foglio TAB_MOD).

L'idea per trasporre la matrice è che in automatico venga definita l'area da trasporre utilizzando l'ultima colonna e l'ultima riga valorizzate nella matrice.

Se però provo ad alimentare una riga in più nella matrice di partenza, il risultato è completamente sballato, nel senso che viene inserita una riga vuota aggiuntiva come se ci fosse una colonna in più da trasporre e non funziona più il filtro dei soli valorizzati. Ne riporto il risultato nel foglio "TAB_MOD con aggiunta riga".

Nel file allegato vi è anche il codice VBA che riporto in basso:

Sub ConvertTable_MOD_pdc()
'Update 20181105 by PDC'

'elimina e ricrea da zero il foglio denominato TAB_MOD'
Dim foglio As Worksheet
Application.DisplayAlerts = False

For Each foglio In Worksheets
If foglio.Name = "TAB_MOD" Then
Sheets("TAB_MOD").Delete
End If
Next foglio
Set nuovofoglio = Worksheets.Add
nuovofoglio.Name = "TAB_MOD"
nuovofoglio.Tab.ColorIndex = 20
For j = 1 To Application.Sheets.Count - 1
If UCase$(Application.Sheets(j).Name) > UCase$(Application.Sheets(j + 1).Name) Then
Sheets(j).Move after:=Sheets(j + 1)
End If

Next
'traspone la matrice sul foglio TAB_MOD'
Sheets("MATRICE_DRIVER MOD").Select
Dim rng As Range
Dim cRNG As Range
Dim rRNG As Range
Dim xOutRng As Range
xTitleId = "PDC Transposer"
Set cRNG = ActiveSheet.Range("G1").End(xlToRight)
Set rRNG = ActiveSheet.Range("D3").End(xlDown)
Set rng = ActiveSheet.Range("G3", ActiveSheet.Cells(cRNG.Column, rRNG.ROW))
Set outRng = Sheets("TAB_MOD").Range("A2")
Set xWs = rng.Worksheet
k = 1
xColumns = rRNG.Column
xRow = cRNG.ROW
For i = rng.Rows(1).ROW To rng.Rows(1).ROW + rng.Rows.Count - 1
For j = rng.Columns(1).Column To rng.Columns(1).Column + rng.Columns.Count - 1
outRng.Cells(k, 1) = xWs.Cells(i, xColumns)
outRng.Cells(k, 2) = xWs.Cells(xRow, j)
outRng.Cells(k, 3) = xWs.Cells(i, j)
k = k + 1
Next j
Next i

Set rng = Nothing
'aggiunge due colonne per le descrizioni'
Dim uCol As Integer
Sheets("TAB_MOD").Select
uCol = Range("a1").Column + 1
Columns(uCol).Insert Shift:=xlToRight
uCol = Range("c1").Column + 1
Columns(uCol).Insert Shift:=xlToRight

'intesta le colonne'
Sheets("TAB_MOD").Select
Range("a1").Select
Selection = "CDC PARTENZA"
Range("B1").Select
Selection = "CDC PARTENZA DESC"
Range("C1").Select
Selection = "CDC ARRIVO"
Range("D1").Select
Selection = "CDC ARRIVO DESC"
Range("E1").Select
Selection = "DRIVER MOD"

'cerco il cdc di partenza'

Dim C As Range, cfind As Range


On Error Resume Next
With Worksheets("TAB_MOD")
Set rng = .Range("A2:A" & .Range("A2").End(xlDown).ROW)
For Each C In rng
With Worksheets("MATRICE_DRIVER MOD")
Set cfind = .Range("D:E").Find(what:=C.Value, lookat:=xlWhole)
If cfind Is Nothing Then
C.Offset(0, 1) = "NO"
Else
C.Offset(0, 1) = cfind.Offset(0, 1).Value
End If
End With
Next C
End With


Set rng = Nothing
Set cfind = Nothing
Set C = Nothing
'cerco il cdc di arrivo'
Sheets("MATRICE_DRIVER MOD").Select
Range("G1").Select

With Worksheets("TAB_MOD")
Set rng = .Range("C2:C" & .Range("C2").End(xlDown).ROW)
For Each C In rng
With Worksheets("MATRICE_DRIVER MOD")
Set cfind = Range("G1").CurrentRegion.Find(what:=C.Value, lookat:=xlWhole)
If cfind Is Nothing Then
C.Offset(0, 1) = "NO"
Else
C.Offset(0, 1) = cfind.Offset(1, 0).Value
End If
End With
Next C
End With


Set rng = Nothing
Set cfind = Nothing
'FILTRO SOLO I DRIVER VALORIZZATI'
Sheets("TAB_MOD").Activate
Dim WorkRng As Range
On Error Resume Next

Set WorkRng = Range("E2")
Set WorkRng = WorkRng.SpecialCells(xlCellTypeBlanks)
If Err = 0 Then
WorkRng.EntireRow.Delete
Set rng = Nothing
Set WorkRng = Nothing
End If

'aggiungo una colonna con la chiave dei cdc togliendo le sbarrette'
Sheets("TAB_MOD").Select
uCol = Range("D1").Column + 1
Columns(uCol).Insert Shift:=xlToRight
Range("e1").Select
Selection = "CHIAVE"
Range("E:E").NumberFormat = "@"
Dim x As Variant
With Worksheets("TAB_MOD")
Set rng = .Range("E2:E" & .Range("C2").End(xlDown).ROW)
x = 1
For Each C In rng
x = x + 1
C = (Replace(Trim((Range("A" & x).Value)) & Trim(Range("C" & x).Value), "/", ""))
Next C
End With


'MOLTIPLICO PER 100 LA COLONNA DEL DRIVER'
Sheets("TAB_MOD").Select
Dim ROW As Variant, M As Variant
With Worksheets("TAB_MOD")
Set rng = .Range("F2:F" & .Range("F2").End(xlDown).ROW)
ROW = 1
For Each C In rng
ROW = ROW + 1
C = Range("F" & ROW).Value * 100
Next C
End With

'FINE'
Sheets("TAB_MOD").Select
Columns("A:F").AutoFit
Range("F:F").NumberFormat = "0.00"
Application.DisplayAlerts = True
End Sub

Chiedo aiuto a voi per capire cosa c'è di sbagliato.

Grazie.

By edit: ho inserito il codice nella sua finestra

Allegati:

You must be logged in to view attached files.

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

Ci ho provato a seguire il flusso del codice, son arrivato a metà e poi mi sono perso 🙂

Ho capito più o meno la filosofia (vabbè forse le trasposizioni si possono fare in modo diverso ma l'importante è il risultato), quello che non afferro bene è proprio l'errore. Per replicarlo, dove devo aggiungere "una riga vuota aggiuntiva"? mi guideresti passo passo?

[pdicinoPartecipante pdicino]

ciao vecchio frac, 

ti basta popolare la riga 63 della colonna C, D e poi mettere un valore in una qualsiasi cella da G in poi nel foglio MATRICE_DRIVER MOD.

ciao.

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

Ok grazie poi ci provo. Adesso ho una cosa urgente per il mio capo  🙂

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

Allora, ho trovato l'inghippo 🙂

Il problema è che la colonna BK dedicata al "totale chk" entra purtroppo nel range di celle da trasporre e quindi, non avendo la cella BK1 alcun valore (la cella BK2 porta la scritta "totale chk"), questa cella vuota viene riportata in colonna B del foglio dei risultati.

Allora basta ridurre il range rng operando un Resize oppure più semplicemente modificando il contatore di colonna togliendo un'unità (e siccome già si toglieva un'unità a causa della dimensione del range, finisce che devi toglierne 2):

For j = rng.Columns(1).Column To rng.Columns(1).Column + rng.Columns.Count - 2

(è la riga 38 del tuo codice).

Sul codice, lo trovo un po' arravogliato ma non ho molto tempo in questi giorni per affinarlo... diciamo che funziona ma potrebbe essere ottimizzato 🙂

[pdicinoPartecipante pdicino]

Grazie davvero per il suggerimento. Quindi seppur uso il comando xltoright per identificare l'ultima colonna poi viene sorpassato dal current region...

[vecchio fracSenior Moderator vecchio frac Karma: 247 pts]

Plausibile... non ho analizzato così a fondo tutto il codice per individuare una soluzione migliore 🙂

Però con la modifica suggerita tutto sembra funzionare in modo coerente.

[pdicinoPartecipante pdicino]

Grazie! Provo e ti faccio sapere.

 

[Autore]

Articoli