Saltar al contenido

ikanni

Miembros
  • Contador de contenido

    225
  • Unido

  • Última visita

  • Days Won

    8

Sobre ikanni

  • Rango
    Miembro

Información de perfil

  • Sexo
  • Localización: Tafalla

Configuraciones

  • Campo que utilizas como separador de argumentos ;

Visitantes recientes del perfil

908 visitas de perfil
  1. ikanni

    Crear un tipo de conteo de ciertos códigos

    Hola Buenas, Me he dado cuenta que había un fallo Bueno ahi esta reparado y funcionando Copia de Risultato_Codice _Cap.xlsm
  2. ikanni

    Crear un tipo de conteo de ciertos códigos

    Según te he entendido con tu ejemplo... Entiendo tambien que como lo pides en este foro quieres que sea una macro, ya que seguramente mas de uno en este foro, te lo hace con funciones. Con Macros también se puede hacer de varias formas. Aqui va la mia. Cómo no se la complejidad de texto que puedan tener los codigos, lo ideal sería usar el objeto dictionary. El codigo lo he comentado para que practiques con este ejemplo y así lo podrás usar con otras situaciones que vendrán en el futuro muy parecidas ;-) Saludos Copia de Risultato_Codice _Cap.xlsm
  3. ikanni

    Macro que se ejecute solo el fin de año

    Hola Jose, No veo las imagenes, pero da igual si cumple la condición eso significa que lo que te puse funciona., pero el código para hacer la copia pues parece que no te funciona. Ahora no tengo tiempo ayudarte.... Doy por hecho que te crea la nueva hoja con el año nuevo y te hace el resto, entonces parece ser que te falla : .... Workbooks("Control JOLOCO Almacenes V 9.9.4.xlsm").Worksheets("Salidas").Copy _ After:=Workbooks("Reporte anual de Salidas.xlsm").Sheets(1) ' copiar hoja en otro libro ....... Sigue el codigo Paso a Paso y mira a ver porque no te hace la copia, seguro que encuentras la solución. Si luego sí tengo teimpo me paso y veo...
  4. ikanni

    Macro que se ejecute solo el fin de año

    Sino pasa es que esta igualdad es falsa. Por lo tanto ahí es donde esta el problema. Haz seguimiento a los datos que recojen las variables y vete depurando. Si sabes usar debug úsalos y sino ponte msgbox para ver que valor cojen. por ejemplo No sé ayudar más. ... msgbox VBA.Format(CDate(fecha), "yyyy") + 1 & "/" & VBA.Format(Date, "yyyy") If VBA.Format(CDate(fecha), "yyyy") + 1 = VBA.Format(Date, "yyyy") Then ...
  5. ikanni

    Macro que se ejecute solo el fin de año

    Hola, Pues no se que puede pasar, es tan sencillo el codigo que tu mismo lo podrias reparar. Yo pondria un punto de interrupción en el If ...... y ver que datos esta pasando y actuar en consecuencia, es que el codigo no tiene mas complicación. No se me ocurre otra cosa.
  6. ikanni

    Busqueda Alfafonetica

    Hola Gerson, En mi ejemplo, no falla el objeto REGEXR, sno que falla el patrón que hice, soy un principiante en la creación de patrones de busqueda. Por eso puse '''''El patron que he creado para tu caso es mejorable , pero bueno es lo que hay .''''' Tambien es verdad que los ejemplos que hay en el ejemplo no son reales, pero para probar hay que forzar extremos de busqueda para ver como se comporta. SI usas nombre reales fallara menos, creo.Y otra solucion es mejorar el patron, que mejorable es. Es cuestion de dedicarle tiempo, como a todo en esta vida. Saludos
  7. ikanni

    Busqueda Alfafonetica

    Hola a todos, Para comparaciones con cadenas de texto lo ideal es el objeto Expresiones Regulares y no cuesta nada crear un medio funcional. Lo complicado de las expresiones regulares es crear el patrón perfecto, pero da mas juego interpretativo que ir letra a letra. El patron que he creado para tu caso es mejorable , pero bueno es lo que hay . Así que cojiendo unas cosas de Antoni del código de arriba y los datos del ejemplo de Gerson, aqui tienes un ejmplo. Si necsitas que se implemete en tu trabajo tendras que poner una excel que se parezca a lo que tienes hecho. Espero te sirva Buscar frases por fonetica_IK.xlsm
  8. ikanni

    Macro que se ejecute solo el fin de año

    Hola, Ya veo que no me he explicado (Salvo Antoni). Una cosa es crear una macro para que se ejecute el ultimo dia de trabajo del año. Eso con lleva que la excel tiene que estar abierta y seguramente un usuario operando el ultimo dia de trabajo del año y hacer una copia de seguridad. y que habria que hacerla al cerrar el libro, ovbiamente. Lo que yo propongo es que la copia de seguridad se haga automaticamente el primer dia del año nuevo. El usuario el primer diia de trabajo abrira la excel y en ese momento se ejecuta la macro, comprueba que es un año mas que la ultima fecha de modificacion del archivo excel en curso y si es verdadero hacemos la copia. Antoni tenias razon es FullName y es +1 pero en la parte izquierda, (Lo hice a pelo sin probar), lo que queria era plasmar la idea. Explicando el codigo Sub FinDeAno() Dim fecha As String ' la Funcion 'filedatetime' te devuelve un dato tipo Variant(date) ' con la fecha de la ultima modificacion del archivo en curso fecha = FileDateTime(ActiveWorkbook.FullName) ' Por cuestion de lógica si el archivo al abrirse y compara que la fecha ultima de modificacion del archivo en curso ' es igual al año en curso + 1 (Se supone que es +1, sino es asi no pasa por If..) ' eso quiere decir que es la primera vez que abro el archivo este año nuevo ' momento de hacer la copia If VBA.Format(CDate(fecha), "yyyy") + 1 = VBA.Format(Date, "yyyy") Then 'ejecuta Macro End If End Sub
  9. ikanni

    Macro que se ejecute solo el fin de año

    Hola, Yo creo que se puede enfocar tambien de otra manera. En vez de buscar la ultima fecha del año, para hacer copia o algo parecido, se puede trabajar con la primera vez que se abre el excel en un año. Osea Si tu abres el excel y es la primera vez del año que la abres se podria hacer entonces la copia. Ademas que te aseguras que ya esta cerrado el año anterior. que me enrollo. Lo hago es que compruebe la ultima fecha que se ha modificado el archivo y si es un año mas que haga la copia. Sub FinDeAno() Dim fecha As String fecha = filedatetime(ActiveWorkbook.Path) If VBA.Format(CDate(fecha), "yyyy") = VBA.Format(Date, "yyyy") + 1 Then 'ejecuta Macro End If End Sub
  10. Hola Iphant, Como te ha dicho Fernando el problema está en Dim Msgbox as String Lo tienes que quitar acortandolo un poco el codigo , esto te deberia funcionar Sub Copiar() Dim Ruta_Estado As String Ruta_Estado = Worksheets("Hoja1").Range("D1").Value If Not Dir(Ruta_Estado) = "" Then MsgBox "Existe" End Sub
  11. ikanni

    Encontrar Textos Diferentes en Celdas

    Hola rabonelli75, Yo con funciones ando torpón pero si puedes usar macros aquí tienes una función que te hace lo que buscas. Espero te sirva Copia de Ejemplo VIno Orujo.xlsm
  12. Hola Jhon, A ver sí te vale esto Ahora Te sigue creando las Hojas sólo sí no existen. Te dejo la primera fila para que ponagas tus encabezados y cada vez que lo pases añade... Copia todas las filas. Solo cojía la primera ya que todos los TXT que pusistes de ejemplo tenian sólo una fila. Imaginé que siempre era así. Que aproveche Sub Veamos() On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Dim cArchivo As String, ruta As String, cad As String, tmp, ult As Long Dim nLineas As Long, i As Integer, Existe As Boolean, DatosmAr, Linea nLineas = FreeFile ruta = ThisWorkbook.Path & "\*.txt" cArchivo = Dir(ruta, 0) Do While cArchivo > "" DatosmAr = "" cArchivo = Dir If Len(cArchivo) = 0 Then Exit Do cad = Left(cArchivo, Len(cArchivo) - 4) Existe = (Worksheets(cad).Name <> "") If Existe Then Worksheets(cad).Select Else Worksheets.Add.Name = cad ruta = ThisWorkbook.Path & "\" & cArchivo Open ruta For Input As #nLineas Do While Not EOF(nLineas) i = i + 1 Line Input #nLineas, cad DatosmAr = DatosmAr & cad & "#" cad = "" Loop i = 0 Close nLineas tmp = Split(DatosmAr, "#") For Each Linea In tmp ult = [A1].Cells(Rows.Count, "A").End(xlUp).Row + 1 With Range("A" & ult) .Value = tmp(i) ' With .Resize(1) .TextToColumns Destination:=Range("B" & ult), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar _ :=",", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _ 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _ , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1)), _ TrailingMinusNumbers:=True End With End With i = i + 1 Next Loop Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
  13. Hola Jhon, Pruebacon esta macro. Hace lo que tu pides. Se necesita ahora depurar para acoplarlo a lo que tu quieras hacer. Por ejemplo los TXT deberan estar en la misma carpeta (modificalo a lo que necesites), etc... Sub Veamos() On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Dim cArchivo As String, ruta As String, cad As String ruta = ThisWorkbook.Path & "\*.txt" cArchivo = Dir(ruta, 0) Do While cArchivo > "" cArchivo = Dir Worksheets.Add.Name = Left(cArchivo, Len(cArchivo) - 4) ruta = ThisWorkbook.Path & "\" & cArchivo Open ruta For Input As #1 Line Input #1, cad Close #1 With [A1] Application.DisplayAlerts = False With .Resize(1) .Cells = Application.Transpose(cad) .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :=",", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _ 1), Array(6, 1)), TrailingMinusNumbers:=True End With End With Loop Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub [/CODE]
  14. ikanni

    Calendario Ingles Maesto Antoni

    Hola Ziipoo III, En mi caso necesitaría ver el calendario de Antoni para intentar poder ayudarte.
  15. ikanni

    Extraer ZIP o RAR Vba - Excel

    Hola a todos, Mauricio en esta direccion tienes otra posiblidad, no lo he probado (no tengo tiempo) pero tiene buena pinta https://excelsignum.com/2017/09/10/descomprimir-archivos-zip-desde-excel-con-vba/
×

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.