Jump to content

isidrod

Members
  • Content Count

    276
  • Joined

  • Last visited

  • Days Won

    5

Reputation Activity

  1. Thanks
    isidrod got a reaction from Maria_80 in Problemas al intentar crear macro con fichero csv separado por ;   
    aver si te sirve este link
  2. Thanks
    isidrod got a reaction from Maria_80 in Problemas al intentar crear macro con fichero csv separado por ;   
    ya no entiendo ahí, si importo un archivo de  bloc de notas se parado por ; lo importo a excel, ese archivo que te pase lo hace, yo trabajo con ese archivo
    saludos
    isidro 
  3. Thanks
    isidrod got a reaction from Maria_80 in Problemas al intentar crear macro con fichero csv separado por ;   
    @Maria_80 te subo el archivo  y le picas en el botón consolidar y seleccionas  el archivo te importa en el la hoja consolidado, sea txt o csv
    es todo lo que pude ayudarte a ver si entendí, espero que te funcione
    saludos 
    isidro
    consolidar-varios-archivos-csv-o-txt-usando-conexion-de-datos-externos-y-vba.xlsm
  4. Like
    isidrod got a reaction from Maria_80 in Problemas al importar fichero .csv separado por punto y coma   
    Sub IMPORTAR_CSV() 'Definimos Variables Dim Consulta As QueryTable, nArchivos As Variant, j As Long, i As Long Dim uFila As Long, Conexiones As Object 'Seleccionamos archivos vti = VBA.Timer nArchivos = Application.GetOpenFilename(FileFilter:="Text Files (*.txt*;*.csv*),*.txt*;.csv*", _ Title:="Seleccionar archivos a importar", MultiSelect:=True) 'Si no seleccionamos nada, salimos del proceso If IsArray(nArchivos) = False Then Exit Sub 'Dimensionamos datos For j = LBound(nArchivos) To UBound(nArchivos) nArchivos(j) = "TEXT;" & nArchivos(j) Next j For j = LBound(nArchivos) To UBound(nArchivos) 'Comprobamos la última fila con datos de la columna A With Sheets("CONSOLIDADO") If Application.CountA(.Range("A:A")) = 0 Then uFila = 1 Else uFila = Application.CountA(.Range("A:A")) + 1 End If 'Iniciamos la consulta Set Consulta = .QueryTables.Add(Connection:=nArchivos(j), Destination:=.Range("A" & uFila)) 'Indicamos parámetros de la consulta que nos interesan: With Consulta .Name = "Datos" .FieldNames = True .PreserveFormatting = True .RefreshStyle = xlInsertDeleteCells .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileCommaDelimiter = False .TextFileOtherDelimiter = "~" 'gregado .TextFileColumnDataTypes = Array(1, 1) 'gregado .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End With Next j 'Eliminamos todas las conexiónes que hemos iniciado. For Each Conexiones In ActiveWorkbook.Connections Conexiones.Delete Next Conexiones MsgBox "LISTO IMPORTADO", , "IMPORTAR TXT" vtf = VBA.Timer - vti VBA.MsgBox VBA.Format(vtf, "0.0000 Seg"), vbInformation, "TIEMPO" End Sub Sub IMPORTAR_CSV() 'Definimos Variables Dim Consulta As QueryTable, nArchivos As Variant, j As Long, i As Long Dim uFila As Long, Conexiones As Object 'Seleccionamos archivos vti = VBA.Timer nArchivos = Application.GetOpenFilename(FileFilter:="Text Files (*.txt*;*.csv*),*.txt*;.csv*", _ Title:="Seleccionar archivos a importar", MultiSelect:=True) 'Si no seleccionamos nada, salimos del proceso If IsArray(nArchivos) = False Then Exit Sub 'Dimensionamos datos For j = LBound(nArchivos) To UBound(nArchivos) nArchivos(j) = "TEXT;" & nArchivos(j) Next j For j = LBound(nArchivos) To UBound(nArchivos) 'Comprobamos la última fila con datos de la columna A With Sheets("CONSOLIDADO") If Application.CountA(.Range("A:A")) = 0 Then uFila = 1 Else uFila = Application.CountA(.Range("A:A")) + 1 End If 'Iniciamos la consulta Set Consulta = .QueryTables.Add(Connection:=nArchivos(j), Destination:=.Range("A" & uFila)) 'Indicamos parámetros de la consulta que nos interesan: With Consulta .Name = "Datos" .FieldNames = True .PreserveFormatting = True .RefreshStyle = xlInsertDeleteCells .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileCommaDelimiter = False .TextFileOtherDelimiter = ";" 'gregado .TextFileColumnDataTypes = Array(1, 1) 'gregado .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With End With Next j 'Eliminamos todas las conexiónes que hemos iniciado. For Each Conexiones In ActiveWorkbook.Connections Conexiones.Delete Next Conexiones MsgBox "LISTO IMPORTADO", , "IMPORTAR TXT" vtf = VBA.Timer - vti VBA.MsgBox VBA.Format(vtf, "0.0000 Seg"), vbInformation, "TIEMPO" End Sub checa ese codigo
    .TextFileOtherDelimiter = "~" este cambia por punto o coma por lo que deseas separar
  5. Thanks
    isidrod got a reaction from benbafel in Macro para unir varios archivos .Txt   
    buen dia @benbafel a ver si te funciona este
    saludos isidro
    importartxt.xlsm
  6. Like
    isidrod got a reaction from Excel_Táctico in Buscar palabra dentro de un texto   
    ahí esta la formula que uso y lo tome de aquí en esta foro  que lo publico @Gerson Pineda espero que te sirva @Excel_Táctico 
    saludos isidro
    Buscar palabra de una lista en un texto.xlsx
  7. Confused
    isidrod reacted to Haplox in Macro para buscar en base de datos por código   
    Te dejo la solución con macros. EL código esta en el evento de la Hoja datos, así que se ejecuta automáticamente al poner el código.
    Pero no te hubiese hecho falta macro, con la fórmula siguiente en la columna B obtienes el mismo resultado
    =BUSCARV(A2;BD!$A$2:$B$8;2)
    Copia de Libro1.xlsm
  8. ¡Excelente!
    isidrod reacted to Gerson Pineda in Buscar palabra dentro de un texto   
    Holas!
    Espero no repetir
    =SI.ERROR(BUSCAR(2^20,1/ESNUMERO(HALLAR($F$6:$F$11,A2)),$F$6:$F$11),"No Existe")  
    Saludos
  9. ¡Excelente!
    isidrod reacted to John Jairo V in Buscar palabra dentro de un texto   
    ¡Hola a ambos!
    Dejo otra opción en el adjunto.  ¡Bendiciones!
    Buscar palabra de una lista en un texto.xlsx
  10. Like
    isidrod got a reaction from Excel_Táctico in Buscar palabra dentro de un texto   
    ahí esta la formula que uso y lo tome de aquí en esta foro  que lo publico @Gerson Pineda espero que te sirva @Excel_Táctico 
    saludos isidro
    Buscar palabra de una lista en un texto.xlsx
  11. ¡Excelente!
    isidrod reacted to John Jairo V in Ayuda formula buscarv+coincidir   
    ¡Hola @joseppp!
    Revisa el adjunto, donde propongo una solución a lo que pides.  ¡Bendiciones!
    Libro1.xlsx
  12. ¡Excelente!
    isidrod reacted to Antoni in Ayuda para completar macro para validar si datos ya existen en la base de datos de Access   
    Set Rs = New ADODB.Recordset Sql = "SELECT Count(*) FROM a_revisiones WHERE [cedula]='" & .Range("J2") & "'" Sql = Sql & " AND [estado]<>'archivo'" Rs.Open Sql, Cnn, 3, 3, adCmdText Datos = Rs.GetRows If Datos(0, 0) > 0 Then MsgBox "El registro ya existe en la base de datos!!!", vbCritical, "Sistema" Else  
  13. ¡Excelente!
    isidrod reacted to JSDJSD in Rango celdas sin conocer el número exacto   
    Sub BorrarDatos() 'primero borro los datos de la hoja Sheets("macro").Range("A2:B55").ClearContents Sheets("macro").Range("D4:F55").ClearContents Sheets("macro").Range("I4:L55").ClearContents 'copio datos de la hoja datos, es la hoja que he tenido que sale del programa milena, tengo que copiar ultimaFila = Sheets("datos").Cells(Rows.Count, 5).End(xlUp).Row Sheets("datos").Range("A2","B" & ultimaFila).Copy Destination:=Sheets("macro").Range("A4") Sheets("datos").Range("C2","E" & ultimaFila).Copy Destination:=Sheets("macro").Range("D4") Sheets("datos").Range("F2","I" & ultimaFila).Copy Destination:=Sheets("macro").Range("I4") ' CeldasVacias Macro ' Las celdas vacías de serie y número se cumplimentan. Range("A4").Select ActiveWindow.SmallScroll Down:=15 Range("A4:A41").Select ActiveWindow.SmallScroll Down:=-54 Selection.SpecialCells(xlCellTypeBlanks).Select Selection.FormulaR1C1 = "=R[-1]C" Range("B4").Select ActiveWindow.SmallScroll Down:=18 Range("B4:B41").Select ActiveWindow.SmallScroll Down:=-60 Selection.SpecialCells(xlCellTypeBlanks).Select Selection.FormulaR1C1 = "=R[-1]C" End Sub Prueba y comenta
  14. ¡Excelente!
    isidrod reacted to Antoni in Hoja específica siempre al final   
    En ThisWorkbook:
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Sheets("La hoja").Move After:=Sheets(Sheets.Count) End Sub  
  15. Thanks
    isidrod got a reaction from Silvia in REALIZAR SUMA POR TIPO DE DATO   
    aver si este es lo que quieres dorgelis
    saludos
    COMISION.xlsx
  16. ¡Excelente!
    isidrod reacted to pegones1 in Calcular el día de la semana en fechas anteriores a 1900   
    Como @Antoni debe estar muy ocupado, adjunto un archivo con 3 macros para obtener el día de la semana desde el 0100-01-01 (aaaa-mm-dd), en formato ISO 8601, que es el primer día admitido por VBA.
    La función GetWeekDayName() devuelve el día de la semana si se le pasa una cadena de texto en formato ISO 8601, llamando a las otras dos macros. Es fácil convertir una string con una fecha en formato de texto al formato estándar ISO.
    Option Explicit Function GetWeekDayName(sDate As String) As String ' ' VBA WeekdayName Function ' Dim iWeekDay As Integer iWeekDay = GetWeekDay(sDate) GetWeekDayName = WeekdayName(iWeekDay, False, vbMonday) End Function Function GetWeekDay(sDate As String) As Integer ' ' VBA WeekDay Function ' Dim dtDate As Date dtDate = GetSerialDate(sDate) GetWeekDay = Weekday(dtDate, vbMonday) End Function Function GetSerialDate(sDate As String) As Double ' ' VBA DateSerial Function ' Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer iYear = Left$(sDate, 4) iMonth = Mid$(sDate, 6, 2) iDay = Right$(sDate, 2) GetSerialDate = DateSerial(iYear, iMonth, iDay) End Function En el fichero adjunto he incluido las fechas especiales que:
    Fechas incorrectas en Excel inferiores al 1900-03-01 Fecha errónea en Excel y en VBA: 1900-02-29, ya que el año 1900 no es bisiesto. Primera fecha correcta en VBA: 0100-01-01 Fechas que no han existido en el Calendario Gregoriano, anteriores al 1582-10-15 Último día correcto en Excel y en VBA: 9999-12-31  @zelarra821 , @isidrod , espero que sea de ayuda y ayude a comprender el mundo pasado, presente y futuro.
    Años Menores que 1900 PW1.xlsm
  17. ¡Excelente!
    isidrod reacted to Cristian 1985 in Extracción de un número dígito a dígito   
    Hola @Tenveo! Adjunto una opción! Saludos!
    Extraer unidades.xlsx
  18. ¡Excelente!
    isidrod got a reaction from zelarra821 in Calcular el día de la semana en fechas anteriores a 1900   
    buen día @zelarra821 te dejo esto este es
    espero que te funcione
    saludos isidro
     
  19. Like
    isidrod reacted to JSDJSD in codigo de agrupacion y eliminacion de datos   
    Hola jhon fredy, como no compartes archivo pues simplemente adapta el código a tus necesidades. Un saludo

  20. ¡Excelente!
    isidrod reacted to AlexanderS in COPIAR DATOS UNICOS SEGUN CONDICION   
    Hola @darkstars9976, prueba este código y me comentas.
    Sub Copia_recetas() Dim Rng$, x# Dim rept As Range Dim celda With Sheets("BD_Recetas") Rng = .Range("D1") x = 9 For Each celda In Sheets("Proy.-Comer").Range(Rng) If celda <> "" Then Set rept = .Range("C9:C43").Find(celda, , , xlWhole) If rept Is Nothing Then _ .Cells(x, "C") = celda: x = x + 1 End If Next End With End Sub Saludos.
×
×
  • Create New...

Important Information

Privacy Policy