Transponer datos por orden de color

Nuevamente estoy pidiendo ayuda por favor... En una oportunidad me paso una macro para traspones datos de la hoja1 a la hoja2... Donde los datos a transponer siempre empezaba cada 10 filas uno nuevo...

Pero en esta ocasión me encuentro que mis datos no siempre empieza cada 10 filas como se puede ver en la imagen adjunto..

3 Respuestas

Respuesta
1

Si no son cada 10 filas, entonces tratando de encontrar otro patrón, puede ser, en la columna A si el texto empieza con letra, entonces es una división, si no es letra entonces no es división.

Es decir, la celda A1, el texto empieza con la letra "M" entonces es SÍ es una división.

La celda A2 empieza con 0, no es división.

La celda A3 empieza con -, no es división.

La celda A10 empieza con espacio, no es división.

La celda A11 empieza con la letra "P" entonces es SÍ es una división.

¿Estás de acuerdo con lo anterior?

buenos días

no se mucho de programación en macros ....por favor si no es mucha molestia puede explicarme como puedo modificar en este código q usted realizo y que me estaba funcionando bien..

Sub Transponer_Datos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    '
    h2.Cells.Clear
    j = 1
    For i = 3 To h1.Range("A" & Rows.Count).End(xlUp).Row Step 8
        h1.Cells(i, "A").Copy h2.Cells(j, "A")
        h1.Cells(i, "E").Copy h2.Cells(j, "B")
        h1.Cells(i, "F").Copy h2.Cells(j, "C")
        j = j + 1
        h1.Range(h1.Cells(i + 1, "A"), h1.Cells(i + 1, "J")).Copy
        h2.Cells(j, "B").PasteSpecial Paste:=xlAll, Transpose:=True
        h1.Range(h1.Cells(i + 2, "A"), h1.Cells(i + 2, "J")).Copy
        h2.Cells(j, "C").PasteSpecial Paste:=xlAll, Transpose:=True
        j = j + 10
        h1.Range(h1.Cells(i + 3, "A"), h1.Cells(i + 3, "J")).Copy
        h2.Cells(j, "B").PasteSpecial Paste:=xlAll, Transpose:=True
        h1.Range(h1.Cells(i + 4, "A"), h1.Cells(i + 4, "J")).Copy
        h2.Cells(j, "C").PasteSpecial Paste:=xlAll, Transpose:=True
        j = j + 10
        h1.Range(h1.Cells(i + 5, "A"), h1.Cells(i + 5, "J")).Copy
        h2.Cells(j, "B").PasteSpecial Paste:=xlAll, Transpose:=True
        h1.Range(h1.Cells(i + 6, "A"), h1.Cells(i + 6, "J")).Copy
        h2.Cells(j, "C").PasteSpecial Paste:=xlAll, Transpose:=True
        j = j + 10
    Next
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    MsgBox "Fin"
End Sub

¿O tal vez se puede trasponer donde encuentre el texto de color verde?

No te estoy pidiendo que hagas el código de programación.

Lo que te pido es que analices tus datos y me digas en cual fila empezar a transponer los datos.

Revisa nuevamente el ejemplo que te puse.

Es decir, la celda A1, el texto empieza con la letra "M" entonces es SÍ es una división.

La celda A2 empieza con 0, no es división.

La celda A3 empieza con -, no es división.

La celda A10 empieza con espacio, no es división.

La celda A11 empieza con la letra "P" entonces es SÍ es una división.

¿Estás de acuerdo con lo anterior?

es lo correcto  =A1;A10;A19;A24;A30;A39 SON DIVISION es texto todos los de color verde.... 

el archivo lo tengo aquí https://1drv.ms/f/s!AARId1lx3NdVgRg 

Tienes varios problemas en tus datos que deberás corregir, ya que la macro no puede arreglarlos, y siempre tendrás problemas para ordenar, clasificar, buscar, contar, etc, etc.

Por ejemplo:

- Tienes días con guión 21-mar (21 martes), pero eso para excel es una fecha, entonces para excel es 21 de marzo de 2020.
- Cada nombre debería tener grupos de filas en pares, es decir, una fila con días y la fila de abajo con horarios.
- En varios nombres falta la fila de abajo con los horarios.

- Tienes nombres con espacios en blanco a la izquierda y también a la derecha. Mira el siguiente ejemplo:

- Tienes celdas vacías y celdas con "- -" deberías de homologar, elige uno de los 2 utilízalo en todas las celdas.

- Puse varias condiciones en la macro para conseguir los resultados esperados. Pero deberás hacer las correcciones en tu información. Como te comenté, arreglar tu información evitará otros errores en el futuro.


Prueba la siguiente macro en el archivo que compartiste. El resultado estará en la "Hoja2".

Cambié el estilo de la macro, ahora el proceso es inmediato. Solamente tendrás que aplicar el formato que tú desees en la "Hoja2".

Sub Transponer_Datos()
'DECLARACIÓN DE VARIABLES
  Dim h1 As Worksheet, h2 As Worksheet
  Dim i As Long, j As Long, k As Long
  Dim a As Variant, b As Variant, m As Variant
  Dim entra As Boolean
'DATOS INICIALES
  Application.ScreenUpdating = False
  Set h1 = Sheets("Hoja1")
  Set h2 = Sheets("Hoja2")
  a = h1.Range("A1:J" & h1.Range("A" & Rows.Count).End(3).Row + 1).Value
  ReDim b(1 To UBound(a) * 10, 1 To 3)
'PROCESO
  For i = 1 To UBound(a) - 1
    If UCase(Left(Trim(a(i, 1)), 1)) Like "[A-Z]" Then
      'Copia titulos
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 2) = a(i, 5)
      b(k, 3) = a(i, 6)
    Else
      'Copia días y horarios
      entra = True
      If UCase(Left(Trim(a(i + 1, 1)), 1)) Like "[A-Z]" Then entra = False
      If IsDate(a(i + 1, 1)) Then
        m = LCase(Format(a(i + 1, 1), "mmm"))
      Else
        m = LCase(Right(Trim(a(i + 1, 1)), 3))
      End If
      If m <> "" Then
        If "lunmarmiejueviesabdom" Like "*" & m & "*" Then entra = False
      End If
      For j = 1 To 10
        k = k + 1
        b(k, 2) = a(i, j)
        If entra Then b(k, 3) = a(i + 1, j)
      Next
      If entra Then i = i + 1
    End If
  Next
'SALIDA
  h2.Range("A:C").ClearContents
  h2.Range("A1").Resize(k, 3).Value = b
  Application.ScreenUpdating = True
End Sub
Respuesta
1
Respuesta
1

¿Antes de hacer una macro para esto me gustaría saber porque te sucede esto? ¿Qué estas haciendo mal para que tengas que hacer esta clase de cosas? Te recomiendo que investigues de forma sencilla como funciona Access, una base de datos super básica para poder gestionar datos como excel no lo hará nunca.

Si me explicas un poco como quieres trasponer esto, quizá veo como se puede hacer. Entiendo que cuando encuentras un titulo verde lo que hay a continuación es la Sección que quieres trasponer, ¿no? Además tendrás que indicarme cual es el color en hexadecimal o rgb que tiene ese texto. Si no es el mismo exactamente no dará resultado. Si le das a las opciones de excel de editar el color debería salirte por ahí el color exacto.

Sin embargo recuerda que sera una solución única para esto en concreto, cualquier cosa ligeramente diferente no servirá. Si estas haciendo algo que te saca este tipo de datos deberías cambiar tu forma de trabajar.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas