Sviluppare funzionalita su Microsoft Office con VBA Trasformare matrice in tabella

Login Registrati
Stai vedendo 8 articoli - dal 1 a 8 (di 8 totali)
  • Autore
    Articoli
  • #7878 Risposta

    pdicino
    Partecipante

      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.
      #7896 Risposta

      vecchio frac
      Moderatore
        16 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?

        #7906 Risposta

        pdicino
        Partecipante

          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.

          #7908 Risposta

          vecchio frac
          Moderatore
            16 pts

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

            #7929 Risposta

            vecchio frac
            Moderatore
              16 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 🙂

              #7930 Risposta

              pdicino
              Partecipante

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

                #7931 Risposta

                vecchio frac
                Moderatore
                  16 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.

                  #7932 Risposta

                  pdicino
                  Partecipante

                    Grazie! Provo e ti faccio sapere.

                     

                  Login Registrati
                  Stai vedendo 8 articoli - dal 1 a 8 (di 8 totali)
                  Rispondi a: Trasformare matrice in tabella
                  Gli allegati sono permessi solo ad utenti REGISTRATI
                  Le tue informazioni:



                  vecchio frac - 592 risposte

                  albatros54
                  albatros54 - 507 risposte

                  Marius44
                  Marius44 - 270 risposte

                  patel
                  patel - 257 risposte

                  Luca73
                  Luca73 - 194 risposte

                  ChatBox per richiedere velocemente assistenza a semplici problematiche

                  Devi fare il login per scrivere nella chat

                  0
                  1