MAcro par aponer datos columna en fila
Necesito ayuda para crear una macro que me ayude a tratar unos datos que importo desde un archivo .asc a Excel. Los datos los vuelca en columna de la siguiente manera:
SECTOR 1
N0231 A -0,0022
N0232 B -0,0022
N0233 C -0,0028
N0234 D -0,003
N0235 EE -0,0026
N0236 F -0,002
SECTOR 2
N0239 A 0,001
N0240 B -0,0014
N0241 C -0,001
N0242 D -0,0012
N0243 EE -0,0022
N0244 F -0,0028
SECTOR 3
N0247 A 0,0024
Etc
Y necesito que tengaen siguiente aspecto:
SECTOR 1 SECTOR 2
A N0231 -0,0022 N0239 0,001
B N0232 -0,0022 N0240 -0,0014
C N0233 -0,0028 N0241 -0,001
D N0234 -0,003 N0242 -0,0012
EE N0235 -0,0026 N0243 -0,0022
F N0236 -0,002 N0244 -0,0028
No se si se entiende con todo así pegado. Pero en resumen es crear una columna con las letras y pasar el valor de cada letra a filas organizadas por el numero de sector.
1 Respuesta
H o l a: Te anexo la macro
Crea en tu archivo 2 hojas con los nombres "origen" y "destino". En la hoja "origen", en la columna "A" y empezando en la fila 1, pon tu información importada.
Sub Sectores()
'Por.Dante Amor
Set h1 = Sheets("origen")
Set h2 = Sheets("destino")
h2.Cells.Clear
h2.[A1] = "Letra"
j = 1
col = 1
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
If UCase(Left(h1.Cells(i, "A"), 6)) = "SECTOR" Then
col = col + 1
h2.Cells(j, col) = h1.Cells(i, "A")
Else
datos = Split(h1.Cells(i, "A"), " ")
letra = Trim(datos(1))
Set b = h2.Columns("A").Find(letra, lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(b.Row, col) = Trim(datos(0)) & " " & Trim(datos(2))
Else
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u, "A") = letra
h2.Cells(u, col) = Trim(datos(0)) & " " & Trim(datos(2))
End If
End If
Next
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Muchas gracias, que rapidez.
A ver si la puedo probar en el curro por que en el Excel que tengo en casa o no me deja o soy muy torpe, por que intento crear la macro y nada error tras error que no la deja grabar.
Si te envié error dime qué mensaje te aparece, presiona depurar y dime en cuál línea se detiene.
Me salta aquí
Sub Botón1_Haga_clic_en()
'
' Botón1_Haga_clic_en Macro
'
Set h1 = Sheets("origen")
no se ha definido sub o función dice
Te anexo la macro actualizada
Sub Sectores()
'Por.Dante Amor
Dim h1, h2, j, col, i, b, datos, letra, u
Set h1 = Sheets("origen")
Set h2 = Sheets("destino")
h2.Cells.Clear
h2.[A1] = "Letra"
j = 1
col = 1
For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
If UCase(Left(h1.Cells(i, "A"), 6)) = "SECTOR" Then
col = col + 1
h2.Cells(j, col) = h1.Cells(i, "A")
Else
datos = Split(h1.Cells(i, "A"), " ")
letra = Trim(datos(1))
Set b = h2.Columns("A").Find(letra, lookat:=xlWhole)
If Not b Is Nothing Then
h2.Cells(b.Row, col) = Trim(datos(0)) & " " & Trim(datos(2))
Else
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u, "A") = letra
h2.Cells(u, col) = Trim(datos(0)) & " " & Trim(datos(2))
End If
End If
Next
MsgBox "Fin"
End Sub
