Transponer varias filas en una sola columna

Tengo una base de datos de clima de varios años pero los datos están de la siguiente forma
estación fecha(año/mes) días del mes (variable)
 17002          1961-01                1 2 3 4 5 6 7 8 9 10 11 12 13 14 15...  31
17002 1961-02 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15... 31
y necesito transponerlas en una sola columna de la siguiente forma
17002    1961-01     1
17002 1961-01 2
17002 1961-01 3
. . .
17002 1961-02 1
Una vez que termine con el mes 01, que coloque el mes siguiente abajo hasta llegar al mes 12 y luego terminando el año, colocar el siguiente año abajo y así sucesivamente, esto necesito automatizarlo ya que la base de datos consta de aproximadamente 40 años y 4 variables por día, si alguien puede ayudarme con una macro (o varias) que pueda automatizarlo se lo agradeceré.

1 Respuesta

Respuesta
1
Option Explicit
Private Sub MiMacro()
Dim FilaBaseLeer As Long
Dim FilaBaseAgregar As Long
Dim ColumnaBaseLeer As Integer
Dim ColumnaBaseAgregar As Integer
Dim Codigo As String
Dim Fecha As String
Dim CadenaVariables As String
Dim Variables() As String
Dim RecorrerVariables As Integer
FilaBaseLeer = 2 'Este valor depende de la fila en que inicien los datos que tienes. No incluye encabezados
ColumnaBaseLeer = 1 'Suponiendo que el codigo de estacion esta en la columna "A"
FilaBaseAgregar = 2 'Dependiendo desde la fila que quieras que inicie la nueva base de datos
ColumnaBaseAgregar = 5 'Dependiendo desde la columna que quieras que inicie la nueva base de datos. En este caso iniciara en la columna "E"
'IMPORTANTE:
'ASEGURATE DE DAR FORMATO DE TEXTO A LA COLUMNA EN QUE QUEDARAN LAS FECHAS
'NO DEBEN HABER FILAS EN BLANCO EN LA BASE ORIGINAL
'VEO QUE EN TU BD LAS VARIABLES ESTAN SEPARADAS POR ESPACIOS. ASEGURATE QUE SOLO HAYA UN ESPACIO ENTRE VARIABLES
'CAMBIA EL NOMBRE "Base de Datos que uso en el còdigo por el de tu hoja, o renombra tu hoja, como quieras
Do While Not IsEmpty(Worksheets("Base de Datos").Cells(FilaBaseLeer, ColumnaBaseLeer))
Codigo = Worksheets("Base de Datos").Cells(FilaBaseLeer, ColumnaBaseLeer)
Fecha = Worksheets("Base de Datos").Cells(FilaBaseLeer, ColumnaBaseLeer + 1)
CadenaVariables = Worksheets("Base de Datos").Cells(FilaBaseLeer, ColumnaBaseLeer + 2)
Variables() = Split(CadenaVariables, " ", -1, vbTextCompare)
For RecorrerVariables = LBound(Variables()) To UBound(Variables())
Worksheets("Base de Datos").Cells(FilaBaseAgregar, ColumnaBaseAgregar) = Codigo
Worksheets("Base de Datos").Cells(FilaBaseAgregar, ColumnaBaseAgregar + 1) = Fecha
Worksheets("Base de Datos").Cells(FilaBaseAgregar, ColumnaBaseAgregar + 2) = Variables(RecorrerVariables)
FilaBaseAgregar = FilaBaseAgregar + 1
Next RecorrerVariables
FilaBaseLeer = FilaBaseLeer + 1
Loop
MsgBox "TERMINADO", vbInformation, "FIN"
'Simule una base de datos con la estructura que muestras y funciono 100%
He revisado la respuesta y voy a probar la macro, te agradezco tu tiempo y la molestia que te tomaste para contestar, si tengo alguna duda espero poder consultarte nuevamente.
Saludos y muchas gracias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas