Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation since 07/01/2021 in all areas

  1. También puedes configurar la hoja desde las propiedades en el proyecto VBA Mira la imagen Saludos
    4 points
  2. ¡Ya está! Para mostrar una imagen que está en la hoja, hay que convertirla a jpg previamente. Abre el adjunto y pulsa sobre un código QR de la columna C. GENERADOR CODIGO QR.xlsm
    3 points
  3. Onkey, tiene un argumento opcional, que es llamar a un procedimiento, bueno ahi agregas el mensaje y listo Sub MostrarMensaje() If Application.OnKey Key:="{c}" Then "MiSub" End Sub Sub MiSub() VBA.MsgBox "Hola mundo" End Sub Saludos
    3 points
  4. Enhorabuena por tu cambio de nombre Silvia, digo ...Laura. Vamos a celebrarlo: Saludos.
    3 points
  5. @paikerr como te va! Si porque es manual, pero lo resuelves de una manera simple, utilizando un evento como Open y listo Tal que: Hoja1.ScrollArea = "A1:H10" Saludos
    3 points
  6. @pegones1 sin afán de sonar negativo al tema ni generar conflicto, tú te mereces el 100% de la nota.
    3 points
  7. Prueba así: Sub last_row() Application.ScreenUpdating = False With Hoja1 For x = 2 To .Range("A" & Rows.Count).End(xlUp).Row If Not .Range("A" & x) = .Range("A" & x + 1) Then .Rows(x).Copy Hoja2.Rows(Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1) End If Next End With End Sub
    3 points
  8. Abre el adjunto, al pulsar sobre la imagen START, se inicia un bucle sin fin, al pulsar sobre la imagen STOP, se detiene. Bucle sin fin.xlsm
    3 points
  9. 👏👏👏.... ¡¡¡Ayyy... qué haríamos sin ti!!!
    3 points
  10. Un poco más rápido y ordenado. Creo que no necesitas el botón buscar, para agilizar se podría condicionar la búsqueda a que se teclearan como mínimo 3 caracteres en el textbox. Ya comentarás. suministros (1).xlsm
    3 points
  11. Adjunto modificacion agregando solución con formula Ecuación Haversine en Excel.xlsm
    3 points
  12. perdón creo que mi gata camino sobre el teclado y corrió el código Contrastar Imagenes.xlsm
    2 points
  13. Hola Te dejo 2 alternativas, una con formula y otra con las poderosas TD Utiliza la que mas se adecue a tus intereses Saludos Busqueda con multiples criterios_GP.xlsx
    2 points
  14. Algo sencillo, te dejo una función que encripta/desencripta de forma alternativa. Con la hoja PNAC activada: 'En un módulo normal Function EncriptaDesencripta(Texto As String) As String For y = 1 To Len(Texto) Mid(Texto, y, 1) = Chr(255 - Asc(Mid(Texto, y, 1))) Next EncriptaDesencripta = Texto End Function Sub Ejemplo() 'Ejemplo de funcionamiento de la función Range("B2") = EncriptaDesencripta(Range("B2")) End Sub
    2 points
  15. Sub Busca() Dim Leyenda As String Application.ScreenUpdating = False For x = 2 To Range("A" & Rows.Count).End(xlUp).Row Leyenda = "" Select Case Range("B" & x) Case Is < 0: Leyenda = "Menor que cero." Case 0: Leyenda = "Igual a cero." Case Is > 0: Leyenda = "Mayor que cero." End Select If Not Range("A" & x) = Range("A" & x + 1) Then Leyenda = Leyenda & " Última fila = " & x & "." End If Range("C" & x) = Leyenda Next End Sub
    2 points
  16. Antoni

    Autocompletado textbox

    Debes usar un combobox en lugar de un textbox. Revisa el adjunto. BUENO (1).xlsm
    2 points
  17. Te adjunto un ejemplo La celda A1 de la hoja2 tiene color de fondo, mismo que va tomar el textbox de la hoja1, cuando la hoja sea la activa Y si seleccionas el textbox, también va tener el mismo efecto, y si seleccionas una celda, se va quitar dicho color Saludos Textbox en hoja_GP.xlsm
    2 points
  18. Corregido y un poco más eficiente: Sub SustituirCaracteres() Dim Valor As String, Celda As Range, Cadena As String Application.ScreenUpdating = False 'Colocar un punto como caracter de sustitución si el caracter a sustiuir se ha de eliminar Cadena = "àaèeìiòoúuäaëeïiöoüuñn,.@.&.=.\./.:.-.%.+.=.^.$.!.¨.|.>.<.®.#.(.`._.©.~.)." '---------------------------------------------------------- Set rango = Range("A1,C7,D10:E14,F1:H1") 'Rango a sustituir '<---------- '---------------------------------------------------------- For Each Celda In rango Valor = Celda.Text For x = 1 To Len(Valor) i = InStr(Cadena, Mid(Valor, x, 1)) If i Mod 2 = 1 Then If Mid(Cadena, i + 1) = "." Then Valor = Replace(Valor, Mid(Cadena, i, 1), "") i = i - 1 Else Valor = Replace(Valor, Mid(Cadena, i, 1), Mid(Cadena, i + 1, 1)) End If End If Next Celda.Value = Valor Next End Sub
    2 points
  19. Adapta el rango a tus necesidades: Sub SustituirCaracteres() cadena1 = "àaèeìiòoúuäaëeïiöoüuñn" cadena2 = ",@&=\/:-%+=^$!¨|><®#(`_©~);" '---------------------------------------------------------- Set rango = Range("A1,C7,D10:E14,F1:H1") 'Rango a sustituir '<---------- '---------------------------------------------------------- For Each celda In rango For x = 1 To Len(celda) i = InStr(cadena1, Mid(celda, x, 1)) If i Mod 2 = 1 Then celda.Value = Replace(celda.Value, Mid(cadena1, i, 1), Mid(cadena1, i + 1, 1)) End If Next For x = 1 To Len(celda) i = InStr(cadena2, Mid(celda, x, 1)) If i > 0 Then celda.Value = Replace(celda.Value, Mid(cadena2, i, 1), "") End If Next Next End Sub
    2 points
  20. hola André 99 tal vez este enlace te brinde alguna ayuda Ver enlace saludos Silvia
    2 points
  21. Hola, El caso es el siguente: Al pagar la cuota #11 el saldo es de C$ 214.48, que generará intereses por C$17.36 al finalizar el siguiente periodo. Luego al llegar la cuota #12 el cliente deberá pagar el saldo C$214.48 + mas los intereses de C$17.36 = C$ 231.84 Digamos las cosas de esta manera, el pago anticipado deberia generar un beneficio, lo que reduciria el valor a pagar en la última cuota, ya que el dinero se pago en forma anticipada. El interes se paga sobre saldos, la redución en el saldo reduce los intereses, el ajuste se puede hacer en la ultima cuota. Saludos.
    2 points
  22. Muerto el perro, se acabó la rabia. Ejemplo: Si quieres la acción sobre la Hoja2: Application.ScreenUpdating = False Set Activa = ActiveSheet Sheets("Hoja2").Activate ActiveWindow.FreezePanes = True Activa.Activate Application.ScreenUpdating = True
    2 points
  23. Windows("Hoja1").FreezePanes = true
    2 points
  24. Hola @Ricky9825 si va hacer de manera manual, podría sugerirte inmovilizar los paneles o aplicar división(split) en la ventana. Si es automático, se puede con una macro por evento, para eso revisa el archivo. Nos comentas Buscar1.1.xlsm
    2 points
  25. Y si solo quieres valores: Sub Copiar() Sheets("TBIS").Range("A2:AS" & Sheets("TBIS").Range("A" & Rows.Count).End(xlUp).Row).Copy Sheets("T").Range("A" & Sheets("T").Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlValues End Sub
    2 points
  26. Prueba esto, a ver si te gusta más. Sub Copiar() Sheets("TBIS").Range("A2:AS" & Sheets("TBIS").Range("A" & Rows.Count).End(xlUp).Row).Copy _ Sheets("T").Range("A" & Sheets("T").Range("A" & Rows.Count).End(xlUp).Row + 1) End Sub
    2 points
  27. Hola de nuevo @Maria_80 Estaba tratando de orientarte, para que de alguna forma, entendieras que hace tu código para que tu misma pudieras solucionarlo. Lamento si esto te incomodo o molesto. No estaba dando una solución en especifico, solo trataba que aprendieras. Me disculpo por el inconveniente. Te dejo una posible solución. ejemplo_copypaste 1.1.xlsm
    2 points
  28. He utilizado un filtro avanzado. La hoja FILTRO puedes ocultarla, pero no eliminarla. Ya contarás como te va. CONTROL 2021 (1).xlsm
    2 points
  29. Hola, Puede usar un =BuscarV( Tambén puede convertir los rangos en tablas, que no dependeran de rangos fijos, si la tabla de los agentes amuenta de tamaño la función se ajusta a los nuevos rangos Las formulas se extienden en forma automatica en la medida que aumentan filas, por lo que no siempre se necesetita cear "arreglos" de datos que se exiendan un extenso numero de filas. Copia de M-RIESGO -PLANTILLA.zip
    2 points
  30. 😂 Como ya me he jubilado ya no me interesan las notas. Lo que me interesa es que quienes usan Excel sean capaces por sí mismos de, con un poco de ayuda, resolver los problemas que les plantean en sus diversas profesiones u oficios o estudios, como a mí me tocó resolver retos mientras fui ingeniero de datos en unas cuantas empresas multinacionales durante mis 10 últimos años de carrera profesional, como se puede ver en este vídeo: YouTube - Mi Carrera Profesional como Ingeniero Salu2, Pedro Wave
    2 points
  31. El archivo New Microsoft Excel Worksheet.xlsm
    2 points
  32. Hola de nuevo @Janlui Te dejo una "maqueta" que te puede ayudar Funciona en 3 pasos: 1.- Click en el icono Navegador (dejas que cargue completa la pagina) 2.- Click en el icono URL 3.- Click en el icono Paste Espero sea de ayuda, nos comentas Sigo atento a tus comentarios, Salud os. G_Maps 1.1.1_.xlsb
    2 points
  33. La propiedad ShowModal solo afecta a la forma de trabajar con los formularios. A True, solo puedes trabajar con el último formulario mostrado, a False puedes trabajar con cualquier formulario mostrado, se pueden modificar los valores y las propiedades de cualquiera de ellos, ya sea desde otro formulario o desde una macro, estén mostrados o no, con independencia de la forma en que se muestren. 🙂
    2 points
  34. Hola Predi. Vamos con la versión 2. Saludos. Factura1_tor2.xlsm
    2 points
  35. Prueba con esta macro: Sub ObtenerSaldos() Dim Producto, Stock, Valor Application.ScreenUpdating = False For x = 2 To Range("A" & Rows.Count).End(xlUp).Row If Not Range("A" & x) = Producto Then Producto = Range("A" & x) Stock = 0 Valor = 0 End If If UCase(Range("B" & x)) = "ENTRADA" Then Stock = Stock + Range("D" & x) Valor = Valor + Range("E" & x) Else Stock = Stock - Range("D" & x) Valor = Valor - Range("E" & x) End If Range("F" & x) = Stock Range("G" & x) = Valor Next End Sub
    2 points
  36. Hola Predi. El problema es la barra inclinada. Prueba el nuevo adjunto. Saludos. Factura1.xlsm
    2 points
  37. Entiendo! Lo quieres corregir desde excel, Utiliza la función LIMPIAR Espero haberte ayudado.
    2 points
  38. Abre el adjunto y pulsa sobre la flecha azul. arraysW.xlsm
    2 points
  39. Si lo que pretendes, es simplemente, copiar todas las filas de la hoja Data que la columna D sea = "Pasta", esa no es la mejor manera, mejor con un filtro y después copiar el resultado. Si te interesa, lo comentas y cuando pueda le echo un vistazo.
    2 points
  40. ¡Ups! me olvidé el archivo. 🤔 suministros Antoni.xlsm
    2 points
  41. El fallo es pensar que WebBrowser usa el navegador Edge, que no genera errores de scripts. El control WebBrowser forma parte de Internet Explorer y solo se puede usar en sistemas que tengan instalado Internet Explorer, como se explica en este enlace. Lo que ocurre es que Internet Explorer no soporta las nuevas scripts de Edge y genera errores que hay que silenciar con este código: Private Sub CommandButton1_Click() Dim ie As WebBrowser ' Pone WebBrowser Set ie = WebBrowser1 ' Ignora errores de script ie.Silent = True ' Navega a la URL de la página Web ie.Navigate "https://youtu.be/njo-zPJZksM" End Sub No he probado esta macro pues en Microsoft 365 no está habilitado el control WebBrowser. Ya me contarás si a ti te funciona. Salu2, Pedro Wave
    2 points
  42. Pues como bien te comenta el Maestro Antoni la búsqueda se puede agilizar condicionando la búsqueda a que se tecleen como mínimo 3 caracteres por ejemplo, pero yo te propongo para que tengas otra opción diferente que la búsqueda comience en el momento que pulses la barra de espacio, prueba y comenta. https://drive.google.com/file/d/1golzEgKBYVkEj1N0IPYhE4hZ7fJK1js2/view?usp=sharing
    2 points
  43. hola a todos He probado todo lo que mencionaste en las imágenes y a mi no me mueve nada como muestras en tus imágenes y es porque posiblemente falte algún detalle que no aclaraste. alicante nuevo está dos veces y no lo encuentra en la hoja inventario. por eso sale ND, nueva llave la inventé y si aparece, y el resto conserva los datos. Eso si, si intentas registrar dos nombres iguales, solo buscará la primera coincidencia, si es que en inventarios tuvieras dos códigos iguales, solo traerá el primero que encuentre. Lo digo porque mencionaste repetir "Prueba"... Al menos adjunta el ejemplo en el que se movieron los códigos, para revisar y decirte el motivo por el que a ti te modifica el código. (si es que lo puede detectar). Saludos, Silvia
    2 points
  44. Cuando usas RowSource, no puedes utilizar el método clear para borrar el listbox, debes borrar la propiedad RowSource. Me.LBProductos.RowSource = "" en lugar de 'Me.LBProductos.Clear, en cualquier caso hay que hacer algunas modificaciones para conseguir lo que buscas. Lo de JSDJSD tiene buena pinta. Tengo un modelo a partir de un filtro avanzado que se ajusta a lo que quieres, luego te lo subo.
    2 points
  45. Hola @roa30 Prueba si te entendí bien... Pd.: tuve que eliminar los datos de la Hoja3 y las líneas del archivo para poder subirlo sin zip. Si deseas agradecer el tiempo invertido en procurar una solución al pedido, abajo a la derecha de cada mensaje encuentras un corazón. Suerte! ae20210702_post45056_suministros.xlsm
    2 points
  46. Hola, Revise el archivo adjunto Ecuación Haversine en Excel.xlsm
    2 points
  47. pegones1

    Imagen de carga

    Prueba el adjunto con un reloj de arena como imagen de carga. Y cambia el bucle y el CODIGO A MODIFICAR a tu gusto... ' Bucle de generación de datos For lBucle = 1 To lFinBucle ' Temporiza 1 segundo If Timer > lTempo + 1 Then ' Muestra el reloj de arena CambiarRelojArena True lTempo = Timer End If ' CODIGO A MODIFICAR Cells(1, 1).Value2 = lBucle Next lBucle Salu2, Pedro Wave RelojArena_PW1.xlsm
    2 points
  48. hola Larzix =BUSCARV(E5,Tabla5[#Todo],7,) mi separador de argumentos es la coma, si el tuyo es otro, corriges. =BUSCARV(E5,Tabla5[#Todo],7,0) =BUSCARV(E5,Tabla5[#Todo],7,FALSO) las 3 son lo mismo. saludos, Silvia PANDORA V_0_0_1 Resp.xlsm
    2 points
  49. ¡Hola @Pirtrafilla! Los comodines en la función SUMAR.SI solamente trabajan con textos, no con números. Dicho esto, puedes usar como alternativa la función SUMAPRODUCTO, de la siguiente forma: =SUMAPRODUCTO(--(IZQUIERDA(F$2:F$8;4)=A2&"");G$2:G$8) ¡Bendiciones!
    2 points
  50. Antoni

    ¡Ya soy novato!

    Me he puesto las pilas este fin de semana y he avanzado 9 rangos de golpe. 🤣
    2 points
  • Newsletter

    Want to keep up to date with all our latest news and information?
    Sign Up
×
×
  • Create New...

Important Information

Privacy Policy