Jump to content

All Activity

This stream auto-updates     

  1. Today
  2. Es perfecto , es lo que trate de hacer y no me resulto, solo una duda, se podrá modificar de alguna manera que la suma no sea mayor al promedio? no se si sera muy complejo eso. Pero de verdad muchas gracias.
  3. Saludos @rsoto.conta te dejo una forma, es las mas simple, ordenas la deuda, y vas asignando valores maximo y minimo a cada cobrador, al final la distribución es uniforme, lo único es que si el valor máximo es muy diferente al resto, pues siempre el primer seleccionado de seguro tendrá un promedio mucho mayor Distribuir Deuda.xlsm
  4. Yesterday
  5. ya revise ambos codigos una disculpa por la demora, y veo que ambos casos son funcionales, pero me surgen algunas dudas al respecto: para el caso de MAURICIO_ODN mi pregunta seria al poner un listbox oculto en el formulario no causaria algun error debido a procedimientos largos e inmanejables (como dice Antoni) o de que otra manera se podria utilizar tu codigo? ya que cuando lo uno al evento change del combobox pais si marca error. para el caso de Antonio, mi pregunta es si solo conoces esa manera?, es decir; en mi idea trato de evitar el uso de varias hojas y dejarlo mas en codigo, disculpame es que ando buscando como que el "termino medio" de las cosas. Aunque es muy bueno hacerlo como lo mencionas, tal vez me adapte a tu idea mejor. de antemano muchas gracias
  6. A ver asi: With Application hoy = VBA.CDate(VBA.Date) mday = .WeekNum(hoy, 2) fmes = .EoMonth(hoy, -1) fec = VBA.Format(mday, "dd/mm/yyyy") uday = .WeekNum(fmes, 2) mes_ = VBA.Month(hoy) resul = VBA.IIf(mes_ = 1, mday, mday - uday + 1) End With
  7. Buenas Tardes Señores/as, Espero se encuentren muy bien junto a sus familias en relación al Virus que bastante nos ha afectado. Quisiera pedirles una orientación u ayuda por favor. Esta es una empresa de cobranza la cual soy el el que distribuye la deuda a cada cobrador. adjunto archivo el cual ocupo, son 25 cobradores , debo distribuir el total de la deuda a estas 25 personas, el cual tengo que tratar que el MONTO y la CANTIDAD sean lo mas parecido parecidos y parejo posible. Cualquiera orientación y/o ayuda se agradece (busque en todo el foro y no encontré algo similar, y si hay, busque mal) Espero tenga una buena tarde, 0807.xlsx
  8. Prueba y comenta Prueba numero semana Prueba 1.xlsm
  9. En el excel que adjunto, en la pestaña listado celda I9, pone un valor (que es variable), lo que quiero es que al darle a imprimir en el ejecutable de la pestaña pegatina, imprima tantas hojas, como el número que pone en la I9. Para este caso pone la I9 29, por lo que en la pestaña pegatinas al ejecutar la macro imprima 29 hojas. Muchas gracias de antemano. Saludos. PEGATINAS CALIBRACIÓN_prueba.xlsm
  10. Gerson Realice el cambio, un solo error el 01-02-2020, me arroja como semana 5, siendo que debería ser 1. Hasta el minuto es el procedimiento que mejor a funcionado, encontrando solo ese error. Muchas gracias por tu tiempo Saludos Cordiales Pedro
  11. Un leve cambio: resul = VBA.IIf(mday <= 5, mday, mday - uday + 1) Saludos
  12. SDJSD Muchas gracias por tu tiempo Realice el mismo ejercicio que para las otras opciones y el resultado es bueno, pero a partir de junio, no calcula el numero de semana. El Valor a la izquierda es el que arroja el código, a la derecha el que debiese ser. 15-02-2020 3 3 VERDADERO 25-06-2020 4 4 VERDADERO 12-12-2020 2 2 VERDADERO 01-01-2020 1 1 VERDADERO 06-01-2020 2 2 VERDADERO 27-01-2020 5 5 VERDADERO 01-02-2020 1 1 VERDADERO 10-02-2020 3 3 VERDADERO 01-03-2020 1 1 VERDADERO 09-03-2020 2 2 VERDADERO 02-03-2020 1 1 VERDADERO 03-03-2020 1 1 VERDADERO 10-03-2020 2 2 VERDADERO 16-03-2020 3 3 VERDADERO 30-03-2020 5 5 VERDADERO 01-04-2020 1 1 VERDADERO 20-04-2020 4 4 VERDADERO 01-05-2020 1 1 VERDADERO 04-05-2020 2 2 VERDADERO 18-05-2020 4 4 VERDADERO 25-05-2020 5 5 VERDADERO 01-06-2020 1 1 VERDADERO 15-06-2020 3 FALSO 12-12-2020 2 FALSO Saludos Cordiales Pedro
  13. Mauricio Haciendo pruebas mas detalladas, se obtienen resultados buenos y malos. El Valor a la izquierda es el que arroja el código, a la derecha el que debiese ser. 01-01-2020 1 1 VERDADERO 06-01-2020 2 2 VERDADERO 27-01-2020 5 5 VERDADERO 01-02-2020 0 1 FALSO 03-02-2020 1 2 FALSO 10-02-2020 2 3 FALSO 17-02-2020 3 4 FALSO 24-02-2020 4 5 FALSO 01-03-2020 1 1 VERDADERO 02-03-2020 1 1 VERDADERO 09-03-2020 2 2 VERDADERO 23-03-2020 4 4 VERDADERO 01-04-2020 1 1 VERDADERO 04-04-2020 1 1 VERDADERO 18-04-2020 3 3 VERDADERO 06-04-2020 2 2 VERDADERO 01-05-2020 0 1 FALSO 04-05-2020 1 2 FALSO 11-05-2020 2 3 FALSO 01-06-2020 1 1 VERDADERO 09-06-2020 2 2 VERDADERO 15-06-2020 3 3 VERDADERO Saludos Cordiales Pedro
  14. Hola Gerson Gusto en saludarte Probé la recomendación VBA.Date por el dato ingresado en el texbox, funciona bien desde febrero a diciembre. Resultados de Enero 02-01-2020 -51 06-01-2020 -50 13-01-2020 -49 20-01-2020 -48 27-01-2020 -47 Saludos Cordiales Pedro
  15. Prueba y comenta Prueba numero semana.xlsm
  16. Genial el efecto de mover el raton sobre el mapa, y se cambia dinamicamente! Respecto al eje del año, sigue como "aa", pero bueno eso es minimo en relacion al impacto de tu aporte! Exitos Padro!
  17. Para que no quede en el tintero, otra opción podría ser así With Application hoy = VBA.Date mday = .WeekNum(hoy, 2) fmes = .EoMonth(hoy, -1) uday = .WeekNum(fmes, 2) resul = mday - uday + 1 End With Saludos a todos!
  18. Checa el archivo: Sub Copia() Application.ScreenUpdating = False Dim Uf As String Dim Ul As Long Ul = Hoja2.Range("G" & Rows.Count).End(xlUp).Row + 2 Uf = Hoja1.Range("G" & Rows.Count).End(xlUp).Row Hoja1.Range("A2:N" & Uf).AutoFilter Field:=7, Criteria1:=">0" Hoja1.Range("A3:N10000").SpecialCells(xlCellTypeVisible).Copy Destination:=Hoja2.Cells(Ul, 1) Hoja1.Range("A3:N" & Uf).EntireRow.Delete Hoja1.Range("A2:N" & Uf).AutoFilter Application.ScreenUpdating = True End Sub Copia de Consulta copiado.xlsm
  19. Hola Jose BN, prueba el adjunto y comenta. Consulta copiadoPrueba1.xlsm
  20. Hola JSDJSD Muchas gracias por tu tiempo y respuesta, la función esta perfecta, pero quería meterlo al userform. Un abrazo Pedro
  21. Muricio Muchas gracias por tu ayuda, me funciona perfecto. Private Sub CommandButton1_Click() Dim ult As Long ult = Cells(Rows.Count, 1).End(xlUp).Row oDay = DateValue(TextBox1.Value) Cells(ult + 1, 1) = CDate(TextBox1.Value) 'FECHA Cells(ult + 1, 2) = Round((13 + Day(oDay) - Weekday(oDay) - 5) / 7, 0) End Sub Un abrazo _____________ Gerson Muchas gracias a ti también, con algo mas de tiempo utilizaré ti recomendación. Saludos Cordiales Pedro
  22. @Gerson Pineda, he corregido algunos errores, entre ellos el que me comentaste, por lo que recomiendo descargar de nuevo el archivo desde el siguiente enlace: Desempleo de la UE con banderas https://pedrowave.blogspot.com/2020/06/desempleo-de-la-ue-con-banderas.html
  23. Buenos días! Amigos del foro quisiera solicitarles el apoyo para resolver el siguiente problema, necesito una macro que me permita copiar de una hoja a otra si se cumplen los siguientes criterios: Si el valor en la columna G de la hoja Diario es mayor que cero, se copien los datos de Diario(hasta la ultima celda con datos) a la hoja BD pegando los datos en la ultima celda vacía de BD. Al copiar aquellos valores mayores a cero en la hoja BD quitarlos de la hoja Diario, solamente dejando los datos que contengan cero o se encuentren vacios en la columna G de la hoja Diario. Lo estuve intentando de la siguiente manera: Sub copiar2() Set J1 = Sheets("Diario") Set J2 = Sheets("BD") j = J2.Range("A" & Rows.Count).End(xlUp).Row + 1 For i = 3 To 79 If J1.Cells(i, "G") > 0 Then J2.Cells(i, "A") = J1.Cells(i, "A") J2.Cells(i, "B") = J1.Cells(i, "B") J2.Cells(i, "C") = J1.Cells(i, "C") J2.Cells(i, "D") = J1.Cells(i, "D") J2.Cells(i, "E") = J1.Cells(i, "E") J2.Cells(i, "F") = J1.Cells(i, "F") J2.Cells(i, "G") = J1.Cells(i, "G") J2.Cells(i, "H") = J1.Cells(i, "H") J2.Cells(i, "I") = J1.Cells(i, "I") J2.Cells(i, "J") = J1.Cells(i, "J") J2.Cells(i, "K") = J1.Cells(i, "K") J2.Cells(i, "L") = J1.Cells(i, "L") J2.Cells(i, "M") = J1.Cells(i, "M") J2.Cells(i, "N") = J1.Cells(i, "N") End If Next MsgBox "Valores copiados" End Sub Saludos JB Consulta copiado.xlsm
  1. Load more activity
×
×
  • Create New...

Important Information

Privacy Policy