VBA incolonnare su tre colonne i dati presenti in tre matrici

Question

Buonasera a tutti,

avrei necessità di scrivere i dati di tre matici (145x13) presenti sul foglio 1 al foglio 2 su tre distinte colonne.

Con la macro che riporto sono riuscito ad incolonnare i dati di una matrice su una colonna, mentre ho avuto qualche difficoltà a parametrizzare le informazioni delle altre due matrici.

Allego il file con il risultato atteso. https://onedrive.live.com/edit.aspx?resid=DD405B0D5A6097C5!6254&cid=dd405b0d5a6097c5&CT=1667147596258&OR=ItemsView Saluti.

Antonino

--

Sub RitornaVettore()

Dim j As Integer

Dim i As Integer

Dim n As Integer

Dim k As Integer

For j = 1 To 13 

    For i = 1 To 145 Step 1 

    Foglio2.Cells(i + n + 1, 1).Value = Foglio1.Cells(i + p + 4, j + 10).Value 

    Next i 

n = (145 \* j) 

Next j 

End Sub

Answer 1

Ciao Antonio,

Ciao Norman,

ho caricato il file di esempio così come da te richiesto.

Le matrici contenute nel foglio 1 sono 40 (Variabili) per 145 (territori) per 13 (anni) da riportare nel foglio 2 su 40 colonne .

https://onedrive.live.com/edit.aspx?resid=DD405B0D5A6097C5!6256&cid=dd405b0d5a6097c5&CT=1667196647725&OR=ItemsView

Prova a sostituire il codice precedente con la seguente versione:

'========>>

Option Explicit

'-------->>

Public Sub RitornaVettore()

Dim srcSH As Worksheet, destSH As Worksheet 

Dim Rng As Range

Dim arrIn As Variant, arrOut() As Variant 

Dim i As Long, j As Long

Dim iRow As Long, iCol As Long 

Dim UB As Long, UB2 As Long 

Dim iCtr As Long, jCtr As Long 

Const iTerritori As Long = **145                                              '<<=== Modifica** 

Const iVariabili As Long = **40                                               '<<=== Modifica** 

Const sFoglio\_Sorgente As String = **"Foglio1"                    '<<=== Modifica** 

Const sFoglio\_Destinazione As String = **"Foglio3"             '<<=== Modifica** 

Const sPrima\_Cella\_Dati As String = **"K5"                           '<<=== Modifica** 

With ThisWorkbook 

    Set srcSH = .Sheets(sFoglio\_Sorgente) 

    Set destSH = .Sheets(sFoglio\_Destinazione) 

End With 

Set Rng = srcSH.Range(sPrima\_Cella\_Dati).CurrentRegion 

arrIn = Rng.Value 

UB = UBound(arrIn) 

UB2 = UBound(arrIn, 2) 

ReDim Preserve arrOut(1 To UB \* UB2 / iVariabili, 1 To iVariabili) 

j = 1 

For i = 1 To UB Step iTerritori 

    For iCol = 1 To UB2 

        For iRow = 1 To iTerritori 

            iCtr = iCtr + 1 

            jCtr = jCtr + 1 

            arrOut(iCtr, j) = arrIn(i - 1 + jCtr, iCol) 

        Next iRow 

        jCtr = 0 

    Next iCol 

    iCtr = 0 

    j = j + 1 

Next i 

With destSH 

    destSH.UsedRange.Offset(1).ClearContents 

    .Range("A2").Resize(UBound(arrOut), iVariabili).Value = arrOut 

End With 

End Sub

'<<========

In futuro il numero di matrici può aumentare così come pure il n. di anni :-)

Se dovessero esserci tali modifiche, dovrebbe essere sufficiente modificare i valori assegnati alle costanti in cima al codice.

Potresti scaricare il mio file di prova Antonio20221031.xlsm

===

Regards,

Norman

Answer 2

Ciao Eleuterio,

intanto ti ringrazio per il codice.

L'ho provato con origine dei dati in K5 ma non mi torna la sequenza presente nel mio file condiviso.

Grazie.

Antonino

Answer 3

Ciao Norman,

ti ringrazio per il tuo codice ... ovviamente va bene!

Ti volevo solo chiedere, visto che le matrici coinvolte sono 40, tutte di dimensione 145x13, come posso adattare il tuo codice a questa mia esigenza?

Preciso infine che i dati stanno sempre tra la colonna K e la W.
Grazie.
Antonino

Answer 4

Ciao Antonino,

ho visto che Norman (ciao) è arrivato un po' prima, ma visto che l'ho scritto:

Sub Trasponi() 

Dim rngM As Range, arrV, lngN As Long, lngNR As Long, lngCol As Long, lngRow As Long, lngR As Long, lngC As Long 

    With Foglio1 

        arrV = .Range(.[K5], .Cells(.Cells(Rows.Count, 11).End(xlUp).Row, .Cells(5, .Columns.Count).End(xlToLeft).Column)) 

    End With 

    Foglio2.Range("A2:C" & Foglio2.Cells(Rows.Count, 1).End(xlUp).Row).ClearContents 

    lngN = UBound(arrV, 1) * UBound(arrV, 2) 

    lngNR = Int(lngN / 3) 

    lngCol = 0 

    For lngC = 1 To UBound(arrV, 2) 

        For lngR = 1 To UBound(arrV) 

            If ((lngC - 1) * UBound(arrV) + lngR - 1) Mod lngNR = 0 Then 

                lngRow = 2 

                lngCol = lngCol + 1 

            End If 

            Foglio2.Cells(lngRow, lngCol).Value = arrV(lngR, lngC) 

            lngRow = lngRow + 1 

        Next lngR 

    Next lngC 

End Sub

ti lascio anche il mio codice, se hai bisogno di spiegazioni chiedi pure, ho solo assunto che il tuo intervallo abbia origine in H5 come da esempio,

ciao.

Answer 5

Ciao Antonio,

avrei necessità di scrivere i dati di tre matici (145x13) presenti sul foglio 1 al foglio 2 su tre distinte colonne.

Con la macro che riporto sono riuscito ad incolonnare i dati di una matrice su una colonna, mentre ho avuto qualche difficoltà a parametrizzare le informazioni delle altre due matrici.

Allego il file con il risultato atteso. https://onedrive.live.com/edit.aspx?resid=DD405B0D5A6097C5!6254&cid=dd405b0d5a6097c5&CT=1667147596258&OR=ItemsView Saluti.

Antonino

--

Sub RitornaVettore()

Dim j As Integer

Dim i As Integer

Dim n As Integer

Dim k As Integer

For j = 1 To 13

For i = 1 To 145 Step 1

Foglio2.Cells(i + n + 1, 1).Value = Foglio1.Cells(i + p + 4, j + 10).Value

Next i

n = (145 * j)

Next j

End Sub

Prova a sostituire il tuo codice con qualcosa del genere:

'========>>

'Option Explicit

'-------->>

Public Sub RitornaVettore()

Dim srcSH As Worksheet, destSH As Worksheet 

Dim srcRng As Range, destRng As Range 

Dim arrIn As Variant, ArrOut() As Variant 

Dim i As Long, j As Long, k As Long, p As Long 

Dim UB As Long, UB2 As Long 

Dim iCtr As Long 

Const sFoglio\_Sorgente As String = **"Foglio1"                   '<<=== Modifica** 

Const sFoglio\_Destinazione As String = **"Foglio3"             '<<=== Modifica** 

Const sMatrice\_Sorgente As String = **"K5:W439"              '<<=== Modifica** 

Const sCella\_Destinazione As String = **"A2"                       '<<=== Modifica** 

Const iRighe As Long = **145** 

With ThisWorkbook 

    Set srcSH = .Sheets(sFoglio\_Sorgente) 

    Set destSH = .Sheets(sFoglio\_Destinazione) 

End With 

Set srcRng = srcSH.Range(sMatrice\_Sorgente) 

Set destRng = destSH.Range(sCella\_Destinazione) 

arrIn = srcRng.Value 

UB = UBound(arrIn) 

UB2 = UBound(arrIn, 2) 

ReDim ArrOut(1 To iRighe \* UB2, 1 To 3) 

For p = 1 To UB2 

    For i = 1 To UB Step iRighe 

        For j = 1 To 3

            For k = 1 To iRighe 

                iCtr = iCtr + 1 

                ArrOut(k + (p - 1) \* iRighe, j) = arrIn(iCtr, p) 

            Next k 

        Next j 

        iCtr = 0 

    Next i 

  Next p 

destRng.Resize(UB2 * iRighe, 3) = ArrOut

End Sub

'<<========

===

Regards,

Norman