Trasposizione Colonne

Hai un problema con Excel?

Nuova discussione

Trasposizione Colonne
di Michele (utente non iscritto) data: 03/09/2013 16:52:15
Ciao!
Ho un foglio di calcolo con dei dati sensibili del cliente ordinati come nel Foglio 1. Quello che vorrei ottenere è un ordinamento come nel Foglio 2. Come posso fare? Grazie per l'aiuto!
di Stortyno (utente non iscritto) data: 03/09/2013 18:53:43
Sai qualcosa di VBA?
di Grograman data: 03/09/2013 21:02:15
Ma soprattutto, quanti dati devi trasporre, avendo un limite di 2^14 colonne puoi trasporre al massimo 2^12 persone!
di Michele (utente non iscritto) data: 04/09/2013 08:24:27
Ciao, grazie per le risposte.

Ho conoscenze base di VBA. Sono circa 44000 record, ma se la macro è la stessa posso splittare i dati in più fogli e poi mergiare i risultati, visto che dopo mi servono solo in lettura.

Grazie mille.

di Grograman (utente non iscritto) data: 04/09/2013 09:15:32
Da provare questo obrobrio, oggi purtroppo non posso starci dietro.
Non ho capito inoltre se i blocchi da 3 celle + spazio saranno sempre e solo quei 3 nomi, quindi 11.000 blocchetti con quei 4 nomi (e in quel caso potrebbe andar bene) oppure sono blocchetti di 4 righe con nomi non meglio definiti (in questo caso NON va bene).

Option Explicit

Sub Nomesub()
  Dim wb As Workbook
  Dim wsFrom As Worksheet, wsTo As Worksheet

  Dim x As Long, i As Long, n As Long, J As Long
  Dim y As Integer, k As Integer
  Dim strR As String, strL As String
  Set wb = ThisWorkbook
  Set wsFrom = wb.Sheets(1)
  Set wsTo = wb.Sheets(2)
  wsTo.Cells.ClearContents
      With wsFrom
        x = .Range("A" & .Rows.Count).End(xlUp).Row
        For J = 0 To 3
        i = 0
        k = 0
        n = 0
        y = wsTo.Cells(1, .Columns.Count).End(xlToLeft).Column + 1
          If y = 2 And wsTo.Cells(1, y - 1) = "" Then y = 1
          For i = J + 1 To x Step 4
            If .Cells(i, 1) <> "" Then
              k = InStr(1, .Cells(i, 1), ":", vbTextCompare)
              strR = Trim(Right(.Cells(i, 1), Len(.Cells(i, 1)) - k))
              strL = Left(.Cells(i, 1), k - 1)
              n = wsTo.Cells(.Rows.Count, J + 1).End(xlUp).Row + 1
              If n = 2 And wsTo.Cells(1, y) = "" Then n = 1
              If n = 1 Then
                wsTo.Cells(n, y) = strL
                wsTo.Cells(n + 1, y) = strR
              Else
                wsTo.Cells(n, y) = strR
              End If
            End If
          Next i
        Next J
      End With
  Set wsFrom = Nothing
  Set wsTo = Nothing
  Set wb = Nothing
End Sub

di Michele (utente non iscritto) data: 04/09/2013 11:39:55
Ciao e grazie mille,

saranno sempre e solo quei tre nomi più spazio. Provo subito!

di HarryBosch data: 04/09/2013 17:01:15
Se i nomi son sempre quelli e la stringa da incolonnare si trova sempre dopo il punto e virgola, allora ecco un'alternativa...

Sub copia_nomi()
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim ur As Long, c As Byte
    Dim nomi() As Variant, n As Variant
    Application.ScreenUpdating = False

    Set wsFrom = Sheets("Foglio1")
    Set wsTo = Sheets("Foglio2")
    
    ur = wsFrom.Cells(Rows.Count, 1).End(xlUp).Row
    nomi = Array("pippo", "pluto", "paperino")

    With wsFrom
        .Rows(1).Insert Shift:=xlDown
        .[a1] = "Elenco"

        For Each n In nomi
            .Range("a1:a" & ur).AutoFilter Field:=1, Criteria1:=n & "*"
            c = c + 1
            .Range("a2:a" & ur).Copy wsTo.Cells(2, c)
            wsTo.Columns(c).Replace n & ": ", Replacement:="", LookAt:=xlPart
            wsTo.Cells(1, c) = n
        Next
        .[a1].AutoFilter
    End With

    Application.ScreenUpdating = True
End Sub

di Michele (utente non iscritto) data: 04/09/2013 18:32:20
Ciao, grazie per le risposte.

In realtà provando le vostre macro mi sono reso conto che i dati erano sporchi (stringhe vuote dopo i due punti o righe vuote duplicate) per cui le macro mi davano qualche errore. Vedendo la riga in cui si bloccavano sono riuscito a pulire i dati ed ora funziona tutto alla perfezione. Grazie mille!
di HarryBosch data: 05/09/2013 00:22:57
Nel mio esempio le righe vuote non creano problemi. Se dopo il nome non c'è nulla, viene riportato il "nulla".
Da apporre una piccola correzione alla variabile ur, in quanto ho aggiunto successivamente un'istruzione per l'inserimento dell'intestazione nel foglio1, che serve nell'utilizzo del filtro:
ur = wsFrom.Cells(Rows.Count, 1).End(xlUp).Row + 1
altrimenti l'ultimo valore della colonna non sarà riportato in nessun elenco.

Vuoi Approfondire?