Saltar al contenido

Transponer si hay datos


Recommended Posts

publicado

Hola;

llevo unos dias intentando transponer unos datos pero no consigo hacerlo, he probado con la función transponer, pero no es exactamente eso lo que quiero.

Tengo los valores ordenador como estan en la hoja "Datos iniciales", y los quiero poner como estan en la hoja "Pasar Datos".

En el ejemplo hay 10 empleados, y 5 conceptos distintos ,pero normalmente ese proceso tiene 500 empleados con unos 15 conceptos.

Si os preguntais como se hace ahora, pues, se hace uno a uno :(, la intencion que tengo, y he probado es pasar los datos mediante access (tabla vinculada), a una tabla oracle, que es donde lo necesito.

pero lo que no consigo es dejar los datos como estan en la hoja "Pasar Datos". los datos se pasan una vez al mes.

Me podriais ayudar porfavor.

Un Saludo.

Jose Maria.

ejemplo.xls

Invitado Cacho R
publicado

Hola! José.

¿Puedes confirmar que la estructura de datos que tienes es tal como la has mostrado, y que los conceptos comienzan a partir de la celda H1, y hacia la derecha "tantos como sean necesarios"?...

publicado

Hola Cacho R;

Exactamente es eso, de echo he comprado a poner unos 100 empledos y gualap es increible lo rapido que va, aunque se crea en otro libro pero bueno. Luego la macro que utilizo para pasar los datos a la tabla vinculada de access pues la copio en el nuevo libro y sin problemas.

si fuera posible para entender un poco mas el codigo, podrias responder a las preguntas que hay 'comentadas en tu codigo, te adjunto el codigo:

Private Sub DatosParaOracle_Click()
'-------------------
' By Cacho Rodríguez
'-------------------
Dim mySh As Worksheet, C As Range, Q1 As Long, Q2 As Long, newRow As Long

Application.ScreenUpdating = False
[h1].Copy [ba1:bb1] 'que quiere decir ba1:bb1? no hay datos en eses rango, ¿no?
[ba2:bb2] = Array("<>0", "<>") ' con este rango igual
If FilterMode Then ShowAllData
Q1 = [a1].End(xlDown).Row - 1 ' con esta linea le digo que mire hasta el final del excel
Set mySh = Workbooks.Add(xlWBATWorksheet).ActiveSheet 'se crea un nuevo libro con los nuevos datos
mySh.Name = "para Oracle" ' a la variable mySh le asignas un nombre de hoja
[a1:f1].Copy mySh.[a1] ' empiezo a copiar en la nueva hoja a partir de a1, el rango a1:f1 de la hoja original ¿el rago se puede cambiar, no?
[h1].Copy mySh.[g1:h1] 'copio en la nueva hoja el valor de h1.
mySh.[g1:h1] = Array("CONCEPTO", "VALOR") ' y mientras que haya valores pues los voy poniendo

For Each C In Range([h1], [h1].End(xlToRight))
Q2 = Evaluate("SUMPRODUCT(--(" & C.Offset(1).Resize(Q1).Address & " <> 0))")
If Q2 > 0 Then
C.Copy [ba1:bb1]
C.Resize(1 + Q1).AdvancedFilter xlFilterInPlace, [ba1:bb2]
newRow = 1 + mySh.[a44444].End(xlUp).Row
[a2:f2].Resize(Q1).Copy mySh.Cells(newRow, "a")
C.Copy mySh.Cells(newRow, "g").Resize(Q2)
C.Offset(1).Resize(Q1).Copy mySh.Cells(newRow, "h")
End If
Next C ' este bucle es el que va generando y copiando en el nuevo archivo los parametros establecidos.

With mySh.[a1].CurrentRegion '¿este bucle es para poner la cabecera de la nueva hoja?
.EntireColumn.AutoFit
.Sort key1:=mySh.[a1], order1:=xlAscending, key2:=mySh.[g1], order2:=xlAscending, Header:=True
End With

ShowAllData
[ba1:bb2].Delete xlShiftToLeft ' el rango ba1:bb2 ¿que haces con el?
Application.ScreenUpdating = True
Set mySh = Nothing
End Sub[/CODE]

aunque parezca una tonteria y yo no sepa crear esa maravilla, por lo menos me gusta entenderlo un poco.

Gracias por todo.

Un Saludo.

Jose Maria.

Invitado Cacho R
publicado

Las cuatro celdas BA1:BB2 están lo suficientemente alejadas de la zona de datos útiles como para que podamos utilizarlas como "celdas auxiliares".

Ésa es la causa por la que -al final del código- sus respectivos contenidos son eliminados.

Después de:

[ba2:bb2] = Array("<>0", "<>")

inserta una línea adicional con:

Exit Sub

y corre el código...

Verás que las cuatro celdas en cuestión quedan dispuestas para aplicar un filtro avanzado.

De hecho: el código mostrado se basa en una sucesión de filros avanzados "tantos como conceptos haya".

Entonces aplica el primer filtro avanzado según te muestro en la imagen:

[ATTACH]29052.vB[/ATTACH]

¿Adviertes que ocurre?...

¡En efecto! quedaron seleccionados los únicos tres empleados que tienen datos asociados al concepto P17.

Hecho lo anterior, el código copia (al nuevo libro) las columnas A:F correspondientes a los empleados que tienen datos en el concepto P17, "arma" la columna G (del nuevo libro) con el concepto P17, y termina copiando los valores asociados.

El loop For Each C - Next C recorre -uno a uno- los conceptos y ejecuta la misma rutina.

En resumen: sólo tienes que entender bien como trabaja un filtro avanzado, cosa que -por cierto- tiene que ver con el Excel y no con el VBA.

Saludos, Cacho R.

post-78958-145877004504_thumb.jpg

Invitado Cacho R
publicado

Q1 = [a1].End(xlDown).Row - 1

Con la lista no filtrada, selecciona la celda A1.

Presiona la tecla Ctrl y -sin soltarla- presiona una sola vez la tecla de dirección (la flecha) hacia abajo.

¿Notaste que pasó?...

¡Hubo un salto "violento" hacia la última celda ocupada de la columna A!

Esa última celda es [a1].End(xlDown), mientras que .Row te brinda su fila. Luego Q1 indicará -desde un comienzo- la cantidad de filas de datos que contiene tu tabla.

_____________________

mySh.Name = "para Oracle"

mySh no es el nombre de la hoja... ¡es la hoja propiamente dicha!.

En lugar de utilizar ActiveSheet utilizo mySh.

El nombre de esa hoja es mySh.Name.

_____________________

[a1:f1].Copy mySh.[a1]

[h1].Copy mySh.[g1:h1]

mySh.[g1:h1] = Array("CONCEPTO", "VALOR")

Estas tres líneas arman el encabezado de la nueva hoja.

Puedes detener la macro después de la tercera línea y verás como queda "armado".

La segunda línea sólo cumple una función: "copiar" el formato de la celda [h1] ya que su contenido es -inmediatamente- establecido por la línea siguiente.

_____________________

With mySh.[a1].CurrentRegion

.EntireColumn.AutoFit

.Sort key1:=mySh.[a1], order1:=xlAscending, key2:=mySh.[g1], order2:=xlAscending, Header:=True

End With

Lo anterior no es -ni por casualidad- un bucle...

Te sugiero que estudies a partir de la propia ayuda del VBA tres cosas:

-> With / End With

-> Autofit (aplicado a una columna)

-> Sort (aplicado a un rango)

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29

    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • Exelente solución mil gracias 
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.