Macro formato de fecha

Quería ver si me pueden ayudar en lo siguiente, tengo la fecha en
las columnas "F:F" y "G:G" y están de la siguiente forma 21/03/12. Estas fechas las extraigo de un archivo txt algunas me las muestra con formato completo es decir 21/03/2012 y otras con el numero de año a dos dígitos, lo que yo hago es convertilas a formato completo 21/03/2012; al momento de aplicar la macro no me los deja todos como dd/mm/yyyy sino que, los días que son inferiores a 12 me los convierte de la siguiente forma mm/dd/yyyy, o sea, el 1er de Dic queda como 12/01/2012 como si fuera 12 de enero. Ya use algunas formas y ninguna me ah resultado, anexo macro:

ultfila = Range("F65536").End(xlUp).Row
Range("F2", Cells(ultfila, 6)).Select 'Selecciona solo el rango de datos
Selection.NumberFormat = "dd/mm/yyyy" 'Cambia al formato que quieres
ultfila = Range("G65536").End(xlUp).Row

Range("G2", Cells(ultfila, 7)).Select 'Selecciona solo el rango de datos
Selection.NumberFormat = "dd/mm/yyyy" 'Cambia al formato que quieres

y vuelvo a correr la macro para cambiar el mes por el dia, y el dia por el mes:

ultfila = Range("F65536").End(xlUp).Row
For Each Cell In Range("F2:F" & ultfila)
fec = Mid(Cell.Value, 1, 2) & "/" & Mid(Cell.Value, 4, 2) & "/" & Mid(Cell.Value, 7, 4)
Cell.Value = CDate(fec)
Next Cell
ultfila = Range("G65536").End(xlUp).Row
For Each Cell In Range("G2:F" & ultfila)
fec = Mid(Cell.Value, 1, 2) & "/" & Mid(Cell.Value, 4, 2) & "/" & Mid(Cell.Value, 7, 4)
If Cell.Value = "00/00/00" Then
'no hagas nada
Else
Cell.Value = CDate(fec)
End If
Next Cell

1 Respuesta

Respuesta
2

Cuando cargas el archivo, las columnas F y G, ¿las cargas como tipo texto?

Si las cargas como tipo texto, ya podríamos tratarlas como un texto y tomar los valores por separado del día, mes y año, si las cargas como fecha o general, excel las convertirá a fecha y hará lo que le pega la gana, es decir, podrá cargar los 2 primeros dígitos como día o como mes, para evitar que excel tome la decisión, carga las columnas como texto.

Después de cargarlas como texto ya podríamos hacer esto

Sub fechas()
For Each cell In Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row)
If Len(cell) = 8 Then
fec = Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 7, 2)
cell.Value = CDate(fec)
Else
fec = Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 7, 4)
cell.Value = CDate(fec)
End If
Next cell
End Sub

Prueba y me comentas

Saludos. Dam

Hola Dam, te comento que cargaba las columnas como general, y me quedaba esta instruccion:
Workbooks.OpenText Filename:="C:\Users\J\Documents\INFO-963-920.dat" _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(4, 1), Array(8, 1), Array(16, 1), Array(57, 1), Array(68, 1), _
Array(83, 1), Array(94, 1), Array(100, 1), Array(105, 1), Array(113, 1), Array(122, 1), _
Array(137, 1), Array(153, 1), Array(169, 1), Array(185, 1), Array(189, 1), Array(198, 1), _
Array(212, 1), Array(223, 1), Array(232, 1), Array(243, 1), Array(249, 1), Array(264, 1), _
Array(277, 1), Array(288, 1), Array(309, 1), Array(342, 1), Array(349, 1), Array(363, 1)) _
, TrailingMinusNumbers:=True
Volvi a cargar el archivo pero ahora como texto y me vuelve a salir la misma instruccion al final... TrailingMinusNumbers:=True
Entonces excel hace lo que le plazca con las fechas... Podria existir alguna otra solucion...??

Y ya verificaste las fechas contra el archivo, cuando ya están en la celda, ¿las fechas están bien o ya les cambió el mes por el día?

Hola, en cuanto extraigo el archivo tengo algunas fechas con formato completo 12/12/2012, y algunas otras me aparecen con formato asi 12/12/12 (al lado de estas me aparece un tringulito verde) si me posiciono ahi me dice que el formato de año esta a dos digitos que si deceo pasarlo a 20xx le doy que si y a todas las demas celdas. Lo que yo hago es cambiarlas todas a formato completo y es ahi donde empieza el problema de intercambio de dia por mes.
SAludos

Por cierto desde un principio están las fechas asi como te menciono y también con el formato cambiado en las que son el dia menor a 12.

¿Pero si tenemos un patrón?

Es decir, si el año (que esta al final de la fecha), es de 2 dígitos, entonces la fecha es mm/dd/aa?

Y si si el año, es de 4 dígitos, entonces la fecha es dd/mm/aaaa?

Si es así, podrías aplicar la macro así:

Sub fechas()
For Each cell In Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row)
If Len(cell) = 8 Then ' la fecha es mm/dd/aa
fec = Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 7, 2)
cell.Value = CDate(fec)
Else 'la fecha es dd/mm/aaaa
fec = Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 7, 4)
cell.Value = CDate(fec)
End If
Next cell
End Sub

Eh aplicado la macro y sigue mostrándome las fechas menores a 12 cambiados el dia por el mes. Si si tengo un patrón, asi tal cual lo explicas, pero sigue sin mostrarme bien las fechas.

Puedes enviarme un archivo texto y tu excel con la macro que hace la carga para revisarlos.

Mi correo [email protected]

Listo Dam eh enviado el archivo.

Saludos.

Ya hice una prueba y cuando le dices que cargue el dato como texto, dentro del parámetro de Array le pone un 1 para formato general y un 2 para texto

Array(13, 1), Array(14, 2)

En tu macro que me enviaste todos los Array dicen 1

Así que vuelve a hacer la prueba con las columnas que representan una fecha y le pones el parámetro 2.

Después identifica para cada columna de fecha en qué posiciones están el día, el mes y el año y ya procedes a pasarlo a la fecha dd/mm/aa

Si quieres que haga los cambios en tu macro dime cuáles columnas son las que necesitas pasar a la fecha dd/mm/aa.

"Suc.Ruta Cuenta N o m b r e Consecutivo # Operación Documento Pzo.Agte Emisión Cobrado Importe Costo Cgos/Abo Saldo DVFecha Ped R.F.C. # Nomina #Bco F.U.M. UlPag Financ IvaFinanc Seguro Comisión Refcia Fec-Nac Impo UlPag RFC-CReal Deleg"

No me había percatado de este cambio, ahora ya me convierte bien las fechas pero el problemas es que todas me las pone en formato mm/dd/yyyy...

Si no es mucha molestia las columnas que necesitan este cambio son Emisión y Cobrado.

Saludos y gracias!

¿Pero te deja las fechas en texto?

¿Y en qué columna están las fechas?

Me puedes enviar tu archivo que tiene la macro

Saludos. Dam

Hola!

Las fechas están en la columna F y G, dentro de la separación están en el array(105,2) y array(113,2). El archivo esta muy pesado... Me las pone en texto. Pero me invierte los días por los meses.

Anexo la macro que utilizo...

Sub Extraer_txt()
'
' Macro para extraer txt
' Hecha por Jazmin Marquez
'
'EXPORTO LOS DATOS DEL TXT A EXCEL
Dim iniTime!
Dim cad As String
Application.ScreenUpdating = False
iniTime = Timer
Workbooks.OpenText Filename:="C:\Users\JJMarquez\Documents\INFO-963-920.dat" _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 1), Array(4, 1), Array(8, 1), Array(16, 1), Array(57, 1), Array(68, 1), _
Array(83, 1), Array(94, 1), Array(100, 1), Array(105, 1), Array(113, 1), Array(122, 1), _
Array(137, 1), Array(153, 1), Array(169, 1), Array(185, 1), Array(189, 1), Array(198, 1), _
Array(212, 1), Array(223, 1), Array(232, 1), Array(243, 1), Array(249, 1), Array(264, 1), _
Array(277, 1), Array(288, 1), Array(309, 1), Array(342, 1), Array(349, 1), Array(363, 1)) _
, TrailingMinusNumbers:=True
'ELIMINO PRIMERAS FILAS CON BASURA, RECORRO LA INFORMACION Y REALIZO PRIMER FILTRO
Rows("1:5").Select
Selection.Delete Shift:=xlUp
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Rows("1:1").Select
Selection.AutoFilter
'ELIMINAR CELDAS EN BLANCO ESPACIOS EN BLANCO
Range("A65000").End(xlUp).Offset(1, 0).Value = "final"
Range("A2").Select
Do While ActiveCell.Value <> "final"
If IsEmpty(ActiveCell) Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
ActiveCell.ClearContents
'ELIMINAR BASURA (CARACTERES ESPECIALES)
Range("A2").Activate
While ActiveCell.Value <> ""
If ActiveCell.Value = " DIR" Then
Selection.EntireRow.Delete
ElseIf ActiveCell.Value = "____" Then
Selection.EntireRow.Delete
ElseIf ActiveCell.Value = "Rela" Then
Selection.EntireRow.Delete
ElseIf ActiveCell.Value = "Suc." Then
Selection.EntireRow.Delete
ElseIf ActiveCell.Value = "=" Then
Selection.EntireRow.Delete
ElseIf ActiveCell.Value = "0" Then
Selection.EntireRow.Delete
ElseIf ActiveCell.Value = "6804" Then
Selection.EntireRow.Delete
ActiveCell.Offset(1, 0).Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
Wend
'ELIMINO BASURA DE OTRA COLUMNA
Range("D2").Activate
While ActiveCell.Value <> ""
If ActiveCell.Value = "a l" Then
Selection.EntireRow.Delete
ElseIf ActiveCell.Value = "a l" Then
Selection.EntireRow.Delete
ActiveCell.Offset(1, 0).Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
Wend
'ELIMINO COLUMNAS QUE NO NECESITO
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("F:H").Select
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("K:Y").Select
Selection.Delete Shift:=xlToLeft
Range("J1").Select
'AGREGO LAS DOS COLUMNAS QUE SE NECESITAN PARA HACER LOS CALCULOS
Range("K1").Select
ActiveCell.FormulaR1C1 = "Capital Anterior"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Venta Nueva"
'CAMBIO TODAS LAS FECHAS A 4 DIGITOS EN EL AÑO
For Each cell In Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row)
If Len(cell) = 8 Then
fec = Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 7, 2)
cell.Value = CDate(fec)
Else
fec = Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 7, 4)
cell.Value = CDate(fec)
End If
Next cell
For Each cell In Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row)
If cell = "00/00/00" Then
' no hagas nada
ElseIf Len(cell) = 8 Then
fec = Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 7, 2)
cell.Value = CDate(fec)
Else
fec = Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 7, 4)
cell.Value = CDate(fec)
End If
Next cell
'ORDENAR DE MAYOR A MENOR EL CONSECUTIVO
Columns("D:D").Select
ActiveWorkbook.Worksheets("INFO-963-920").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("INFO-963-920").Sort.SortFields.Add Key:=Range("D1" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("INFO-963-920").Sort
.SetRange Range("A2:J65536")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'MOVER LA COLUMNA DE CONSECUTIVO A LA PRIMERA COLUMNA "A"
Columns("D:D").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight

Cambia el código de los for , por este

'CAMBIO TODAS LAS FECHAS A 4 DÍGITOS EN EL AÑO
For Each cell In Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row)
If cell.Value = "" Then
Else
If Len(cell) = 8 Then
fec = Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 7, 2)
cell.Value = CDate(fec)
Else
fec = Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 7, 4)
cell.Value = CDate(fec)
End If
End If
Next cell
For Each cell In Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row)
If cell.Value = "" Then
Else
If Len(cell) = 8 Then
fec = Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 7, 2)
cell.Value = CDate(fec)
Else
fec = Mid(cell.Value, 4, 2) & "/" & Mid(cell.Value, 1, 2) & "/" & Mid(cell.Value, 7, 4)
cell.Value = CDate(fec)
End If
End If
Next cell

'Fin actualizar fechas

Prueba y me comentas

Saludos. Dam

Wow!! Ahora sii ya quedo, uff muchas gracias Dam por tu valiosa ayuda y por tanto tiempo invertido... Me gustaría entender el porque no me hacia bien la conversión, había un espacio en blanco en cada fecha?

Pues de nuevo mil agradecida con tu gran talento!!

SAludos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Macro para modificar tipo de fecha

Tengo que volver a preguntar. Antes planteé la siguiente pregunta : "Tengo en una columna fechas con el formato 09.01.2009 Para conseguir pasarlas al formato 09/01/2009 tengo la siguiente macro, la cual debería simplemente reemplazar "." por "/":...
1 respuesta

Uso Userform para alimentar una base de datos con fechas pero las registra invirtiendo el formato

Tengo una macro cuyo código es el siguiente: Private Sub Userform_Initialize() Sheets("Listas").Select Range("A1").Select While ActiveCell <> "" ComboBox1.AddItem ActiveCell ActiveCell.Offset(1, 0).Select Wend Sheets("INICIO").Select End Sub Private...
1 respuesta

Filtro en un Formulario VBA Excel

Otra vez, Estoy en la parte de filtrar información de la base de datos... Les cuento un poco como funciona el programita que estoy haciendo para que entiendan por que quiero filtrar de esta forma. Los usuarios que usen el programa no pueden ver las...
1 respuesta

Macro que busque un valor en una columna y que lo pegue en otra columna de otro libro.

Tengo un señor problema, resulta que tengo 20 datos en la columna E de un libro llamado DESVIACIONES, necesito buscar desde la E7 hasta la E26 los datos mayores o iguales a 0, si encuentra alguno que lo copie y lo peque en otra hoja llamada Hoja2 en...
1 respuesta

Macro para buscar valor "#N/A" en una columna

Me podrían ayudar con esta macro, Tengo una macro que me genera un reporte de inventario en un archivo excel, el archivo tiene códigos y formulas para la descripción de cada código, Ejemplo. Código descripción 001 zanahorias. 002 cebollas. 003...
1 respuesta

Buscar numero de factura para que no se repita

Nuevamente solicito su ayuda En el ingreso de esta factura me envía un mensaje indicando que la factura ya fue ingresada pero es posible que 2 proveedores puedan tener la misma serie de documentos mi pregunta como puedo hacer para que el al ingresar...
1 respuesta

Permitir solo determinado formato en celdas

Solicitando nuevamente te ayuda. Como podría hacer para que en una hoja de Excel llamada Datos, la columna A (Consecutivo) acepte solo números; la columna B (Descripción) acepte solo texto y por ultimo la columna C (Fecha) solo fechas. Ademas si al...
1 respuesta

Filtrar datos de varias hojas a una

Tengo un libro de excel donde llevo mi contabilidad y necesito sacar un reporte pór dia mis hojas todas tienen los mismos campos EJEMPLO HOJA1 ESTOS MIS CABEZERAS A B C D E F G H 1fecha empresa banco cuenta deposito costo gasto saldo 2 01/01/12 ALFIL...
1 respuesta

Copiar datos de una pestaña a otra con macro

No domino para nada las macros y necesito su ayuda, tengo un archivo con varias pestañas con igual formato y una pestaña más que llamaré "Total" donde pienso concentrar lo contenido en esas pestañas. Necesito copiar el texto de 2 columnas de cada...
1 respuesta

Tengo este código en Visual basic para Excel, y no me funciona.

El código es el siguiente: Private Sub Worksheet_Change(ByVal Target As Range) 'Por.jom uf = Range("H" & Rows.Count).End(xlUp).Row If Target.Count > 1 Then Exit Sub If Not IsNumeric(Target) Then Exit Sub If Target = "" Then Target.Interior.ColorIndex...
1 respuesta