scambia righe e colonne

Question

Salve,

da una queri che persca dati da una tabella di circa 4-500000 records, necessito di 

• creare una maschera per filtrare la query con i dati desiderati( e a questo ci penserò oltre) e da questa
• scambiare i campi e valori tra righe e colonne: come una sorta di trasposizione in excel.

Con la tabella a campi incrociati non sono riuscito a realizzare il risultato sperato

A titolo informativo, i campi "art" sono circa 230, quindi un inserimento manuale sarebbe troppo lungo, visto che è un lavoro che dovrò fare tutti i giorni.

Di seguito un esempio:

Query originale:

etich	numero1	nome	giorno	art1	art2	art3	art4
1	102560	pippo	05/04/2014	2	4	5	1
2	102560	pippo	06/04/2014	4	3	-	6
3	102560	pippo	08/04/2014	8	-	4	-
4	102560	pippo	09/04/2014	7	2	-	9
5	153451	mario	05/04/2014	6	6	3	-
6	153451	mario	06/04/2014	3	8	1	-
7	153451	mario	08/04/2014	9	4	5	-
8	153451	mario	09/04/2014	1	4	7	2

Query finale/desiderata:

etich	1	2	3	4	5	6	7	8
numero1	102560	102560	102560	102560	153451	153451	153451	153451
nome	pippo	pippo	pippo	pippo	mario	mario	mario	mario
giorno	05/04/2014	06/04/2014	08/04/2014	09/04/2014	05/04/2014	06/04/2014	08/04/2014	09/04/2014
art1	2	4	8	7	6	3	9	1
art2	4	3	-	2	6	8	4	4
art3	5	-	4	-	3	1	5	7
art4	1	6	-	9	-	-	-	2

Grazie per il prezioso supporto.

Answer 1

Ciao Andrea,

forse il seguente codice puo' esserti utile (devi variare il nome della tabella Table2):

Tieni presente che se come dici la tabella origine ha 500000 records non potrai ottenere una tabella con così tante colonne!!!!

Se l'input al presente codice è una query, allora sostituisci:

Set myRstIn = CurrentDb.OpenRecordset("Select * from Table2")

con

Set myRstIn = CurrentDb.OpenRecordset("NomeQuery")

---

Option Compare Database

Option Explicit

Function Transpose()

Dim myRstIn As Recordset

Dim myRstOut As Recordset

Dim myTd As TableDef

Dim iR As Double

Dim iC As Double

Dim iFld As Double

Dim Matrice() As String

   Set myRstIn = CurrentDb.OpenRecordset("Select * from Table2")

   myRstIn.MoveLast

   ReDim Matrice(myRstIn.Fields.Count - 1, myRstIn.RecordCount - 1)

   myRstIn.MoveFirst

   On Error Resume Next

   Set myRstOut = CurrentDb.OpenRecordset("Table3")

   If Err.Number = 0 Then

      DoCmd.SetWarnings False

      myRstOut.Close

      DoCmd.RunSQL ("Drop Table Table3")

      If Err.Number > 0 Then

         MsgBox "Tabella non eliminabile!"

         Exit Function

      End If

      DoCmd.SetWarnings True

   End If

   Err.Clear

   Set myTd = CurrentDb.CreateTableDef("Table3")

   On Error GoTo 0

   For iFld = 0 To myRstIn.RecordCount - 1

       myTd.Fields.Append myTd.CreateField("Col" & Format(iFld + 1, "##"), dbText)

   Next iFld

   For iC = 0 To myRstIn.RecordCount - 1

       For iR = 0 To myRstIn.Fields.Count - 1

           Matrice(iR, iC) = myRstIn(iR)

       Next iR

       If iC = 0 Then

          CurrentDb.TableDefs.Append myTd

       End If

       myRstIn.MoveNext

       If myRstIn.EOF Then

          GoTo Scrivi

       End If

   Next iC

Scrivi:

   Set myRstOut = CurrentDb.OpenRecordset("Table3")

   For iR = 0 To myRstIn.Fields.Count - 1

       myRstOut.AddNew

       For iC = 0 To myRstIn.RecordCount - 1

           myRstOut(iC) = Matrice(iR, iC)

       Next iC

       myRstOut.Update

   Next iR

   myRstOut.Close

   myRstIn.Close

   Set myRstOut = Nothing

   Set myRstIn = Nothing

End Function

Ciao Mimmo

Answer 2

Se ho capito bene :-)

Option Compare Database

Option Explicit

Function Transpose()

Dim myRstIn As Recordset

Dim myRstOut As Recordset

Dim myTd As TableDef

Dim iR As Double

Dim iC As Double

Dim iFld As Double

Dim Matrice() As String

   Set myRstIn = CurrentDb.OpenRecordset("Select * from Table2")

   myRstIn.MoveLast

   ReDim Matrice(myRstIn.Fields.Count - 1, myRstIn.RecordCount - 1)

   myRstIn.MoveFirst

   On Error Resume Next

   Set myRstOut = CurrentDb.OpenRecordset("Table3")

   If Err.Number = 0 Then

      DoCmd.SetWarnings False

      myRstOut.Close

      DoCmd.RunSQL ("Drop Table Table3")

      If Err.Number > 0 Then

         MsgBox "Tabella non eliminabile!"

         Exit Function

      End If

      DoCmd.SetWarnings True

   End If

   Err.Clear

   Set myTd = CurrentDb.CreateTableDef("Table3")

   On Error GoTo 0

   For iFld = 0 To myRstIn.RecordCount - 1

       myTd.Fields.Append myTd.CreateField(CStr(myRstIn(0)), dbText)

       myRstIn.MoveNext

   Next iFld

   CurrentDb.TableDefs.Append myTd

   myRstIn.MoveFirst

   For iC = 0 To myRstIn.RecordCount - 1

       For iR = 1 To myRstIn.Fields.Count - 1

           If iC = 0 Then

              Matrice(iR, iC) = myRstIn(iR - 1).Name

           Else

              Matrice(iR, iC) = myRstIn(iR)

           End If

       Next iR

       myRstIn.MoveNext

       If myRstIn.EOF Then

          GoTo Scrivi

       End If

   Next iC

Scrivi:

   Set myRstOut = CurrentDb.OpenRecordset("Table3")

   For iR = 1 To myRstIn.Fields.Count - 1

       myRstOut.AddNew

       For iC = 0 To myRstIn.RecordCount - 1

           myRstOut(iC) = Matrice(iR, iC)

       Next iC

       myRstOut.Update

   Next iR

   myRstOut.Close

   myRstIn.Close

   Set myRstOut = Nothing

   Set myRstIn = Nothing

End Function

Mimmo

Answer 3

Ciao Mimmo,

e scusa per il ritardo in risposta.

Eccellente il tuo script.

Manca solo la trasposizione dei valori della prima colonna in intestazione colonne(cioè i records sotto "etich": 1,2,3,4,5,6,7,8) e (le intestazioni colonna della table2(cioè "numero1,nome,giorno,art1,art2",etc), in records sotto etich.

Ho tentato di correggere ma senza successo.

sapresti modificare lo script per lo scopo?

In attesa ti ringrazio per l'aiuto.

Answer 4

Ciao Andrea78m,

quanti sono i valori del campo etich ? solo 8 ?

hai mostrato un risultato denormalizzato della Query originale da cui è molto laborioso ottenere il risultato voluto.

Puoi mostrare la struttura della tabella/tabelle originali ?

Ciao

Giorgio Rancati