Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: Bazooka en Diciembre 04, 2010, 05:05:09 pm
-
Hola necesito una función que me devuelva la fecha juliana en 4 dígitos (SI O SI 4 DIGITOS).
Estoy utilizando esta pero no funciona bíen por que a veces me devuelve sólo 3 dígitos por ejemplo cuando le paso la fecha 28/01/2010.
Sería fácil completar con un cero adelante o atrás pero no creo que sea la solución correcta para ello.
Otra cosa es que tengo esta función para convertir a juliana pero no al revés para volverla a fecha por lo que no puedo probar su eficacia.
Este es el código:
Private Sub Command1_Click()
Debug.Print Convert(Text1)
End Sub
'
Private Function Convert(fecha As String) As String
Dim JdMon As String
' Dim Tmonth As String
Dim JdDay As String
Dim JdYear As String
Dim Jan As Integer
Dim Feb As Integer
Dim Mar As Integer
Dim Apr As Integer
Dim May As Integer
Dim Jun As Integer
Dim Jul As Integer
Dim Aug As Integer
Dim sep As Integer
Dim Otb As Integer
Dim Nov As Integer
Dim Dec As Integer
Dim JulianDate As String
Dim LeapYears As String
JdDay = Format$(Day(fecha), "00")
JdMon = Format$(Month(fecha), "00")
JdYear = Format$(Year(fecha), "0000")
Jan = 31
Feb = 28
Mar = 31
Apr = 30
May = 31
Jun = 30
Jul = 31
Aug = 31
sep = 30
Otb = 31
Nov = 30
Dec = 31
LeapYears = DateSerial(JdYear, JdMon, JdDay)
' Call LeapYear
Select Case JdMon
Case "01" 'jan
JulianDate = JdDay
Case "02" 'feb
JulianDate = JdDay + Jan
Case "03" 'mar
JulianDate = JdDay + Jan + Feb
Case "04" 'apr
JulianDate = JdDay + Jan + Feb + Mar
Case "05" 'may
JulianDate = JdDay + Jan + Feb + Mar + Apr
Case "06" 'jun
JulianDate = JdDay + Jan + Feb + Mar + Apr + May
Case "07" 'jul
JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun
Case "08" 'aug
JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul
Case "09" 'sep
JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul + Aug
Case "10" 'oct
JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul + Aug + sep
Case "11" 'nov
JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul + Aug + sep + Otb
Case "12" 'dec
JulianDate = JdDay + Jan + Feb + Mar + Apr + May + Jun + Jul + Aug + sep + Otb + Nov
End Select
Dim tmp
tmp = JulianDate
tmp = Right(JdYear, 1) & JulianDate
Convert = tmp
End Function
P/D He visto muchas otras pero que devuelven 5 numeros y otras 6 pero en este caso tengo solo 4 espacios para insertar una fecha en un codigo de barras.
-
Sinceramente no me agradas >:( pero encontre algo que talvez quieras leer
debes de usar la instrucción: DateDiff, en la ayuda del MSDN, encuentras lo siguiente:
DateDiff (Función)
Devuelve un valor de tipo Variant (Long) que especifica el número de intervalos de tiempo entre dos fechas determinadas.
Sintaxis
DateDiff(intervalo, fecha1, fecha2[, primerdíasemana[, primerasemanaaño]])
La sintaxis de la función DateDiff consta de los siguientesargumentos con nombre:
Parte Descripción
Intervalo Requerido.Expresión de tipo cadena con el intervalo de tiempo utilizado para calcular la diferencia entre fecha1 y fecha2.
Fecha1, fecha2 Requerido; Variant (Date). Las dos fechas que se van a utilizar en el cálculo.
Primerdíasemana Opcional.Constante que especifica el primer día de la semana. Si no se especifica, se asume que es el domingo.
Primerasemanaaño Opcional. Constante, que especifica la primera semana del año. Si no se especifica, se asume que es aquélla en la que se encuentre el 1 de enero.
Valores
Elargumento intervalo toma los valores siguientes:
Intervalo Descripción
yyyy Año
q Trimestre
m Mes
y Día del año
d Día
w Día de la semana
ww Semana
h Hora
n Minuto
s Segundo
El argumento primerdíasemana toma los siguientes valores:
Constante Valor Descripción
vbUseSystem 0 Utilice la configuración de la API de NLS.
vbSunday 1 Domingo (predeterminado)
vbMonday 2 Lunes
vbTuesday 3 Martes
vbWednesday 4 Miércoles
vbThursday 5 Jueves
vbFriday 6 Viernes
vbSaturday 7 Sábado
Constante Valor Descripción
vbUseSystem 0 Utilice la configuración de la API de NLS.
vbFirstJan1 1 Empieza con la semana en la que se encuentra el 1 de enero (predeterminado).
vbFirstFourDays 2 Empieza con la primera semana que tenga al menos cuatro días en el nuevo año.
vbFirstFullWeek 3 Empieza con la primera semana que esté completamente incluida en el nuevo año.
Comentarios
Puede utilizar la función DateDiff para determinar el número de intervalos especificados que existen entre dos fechas. Por ejemplo, con DateDiff podría calcular el número de días entre dos fechas o el número de semanas entre hoy y el final del año.
Si desea saber el número de días entre fecha1 y fecha2, puede utilizar Día del año ("y") o Día ("d"). Cuando intervalo es Día de la semana ("w"), DateDiff devuelve el número de semanas entre las dos fechas. Si fecha1 es lunes, DateDiff contará el número de lunes hasta fecha2. En la cuenta incluirá fecha2, pero no fecha1. Si intervalo es Semana ("ww"), la función DateDiff devolverá el número de semanas entre las dos fechas. En este caso contará el número de domingos entre fecha1 y fecha2. DateDiff contará fecha2 si es domingo, pero no fecha1, aunque sea domingo.
Si fecha1 se refiere a un momento posterior en el tiempo a fecha2, la función DateDiff devolverá un número negativo.
El argumento primerdíasemana afecta a los cálculos que utilizan "w" y "ww" como símbolos de intervalo.
Si fecha1 o fecha2 es unliteral de fecha, el año, si se especifica, pasará a ser una parte permanente de la fecha. Sin embargo, si fecha1 o fecha2 está comprendida entre comillas dobles ("") y se omite el año, se insertará el año en curso en el código cada vez que se evalúe la expresión fecha1 o fecha2. Así es posible escribir código que se pueda usar en años distintos.
Cuando compara el 31 de diciembre con el 1 de enero del año siguiente, DateDiff para un año ("yyyy") devolverá 1 aunque sólo haya pasado un día.
-
@MIKE
Como que en 4 digitos?
La conversion de 12/10/12 seria igual que la de 12/10/62...
Option Explicit
Private Function CJulian(ByVal myDate As Date) As String
CJulian = Format$(myDate, "yy") & Format$((myDate - DateValue("1/1/" & Year(myDate)) + 1), "000")
End Function
Private Sub Command1_Click()
Debug.Print CJulian(CDate(Text1.Text))
End Sub
DoEvents! :P
-
Sinceramente no me agradas >:( pero encontre algo que talvez quieras leer
debes de usar la instrucción: DateDiff, en la ayuda del MSDN, encuentras lo siguiente:
DateDiff (Función)
Devuelve un valor de tipo Variant (Long) que especifica el número de intervalos de tiempo entre dos fechas determinadas.
Sintaxis
DateDiff(intervalo, fecha1, fecha2[, primerdíasemana[, primerasemanaaño]])
La sintaxis de la función DateDiff consta de los siguientesargumentos con nombre:
Parte Descripción
Intervalo Requerido.Expresión de tipo cadena con el intervalo de tiempo utilizado para calcular la diferencia entre fecha1 y fecha2.
Fecha1, fecha2 Requerido; Variant (Date). Las dos fechas que se van a utilizar en el cálculo.
Primerdíasemana Opcional.Constante que especifica el primer día de la semana. Si no se especifica, se asume que es el domingo.
Primerasemanaaño Opcional. Constante, que especifica la primera semana del año. Si no se especifica, se asume que es aquélla en la que se encuentre el 1 de enero.
Valores
Elargumento intervalo toma los valores siguientes:
Intervalo Descripción
yyyy Año
q Trimestre
m Mes
y Día del año
d Día
w Día de la semana
ww Semana
h Hora
n Minuto
s Segundo
El argumento primerdíasemana toma los siguientes valores:
Constante Valor Descripción
vbUseSystem 0 Utilice la configuración de la API de NLS.
vbSunday 1 Domingo (predeterminado)
vbMonday 2 Lunes
vbTuesday 3 Martes
vbWednesday 4 Miércoles
vbThursday 5 Jueves
vbFriday 6 Viernes
vbSaturday 7 Sábado
Constante Valor Descripción
vbUseSystem 0 Utilice la configuración de la API de NLS.
vbFirstJan1 1 Empieza con la semana en la que se encuentra el 1 de enero (predeterminado).
vbFirstFourDays 2 Empieza con la primera semana que tenga al menos cuatro días en el nuevo año.
vbFirstFullWeek 3 Empieza con la primera semana que esté completamente incluida en el nuevo año.
Comentarios
Puede utilizar la función DateDiff para determinar el número de intervalos especificados que existen entre dos fechas. Por ejemplo, con DateDiff podría calcular el número de días entre dos fechas o el número de semanas entre hoy y el final del año.
Si desea saber el número de días entre fecha1 y fecha2, puede utilizar Día del año ("y") o Día ("d"). Cuando intervalo es Día de la semana ("w"), DateDiff devuelve el número de semanas entre las dos fechas. Si fecha1 es lunes, DateDiff contará el número de lunes hasta fecha2. En la cuenta incluirá fecha2, pero no fecha1. Si intervalo es Semana ("ww"), la función DateDiff devolverá el número de semanas entre las dos fechas. En este caso contará el número de domingos entre fecha1 y fecha2. DateDiff contará fecha2 si es domingo, pero no fecha1, aunque sea domingo.
Si fecha1 se refiere a un momento posterior en el tiempo a fecha2, la función DateDiff devolverá un número negativo.
El argumento primerdíasemana afecta a los cálculos que utilizan "w" y "ww" como símbolos de intervalo.
Si fecha1 o fecha2 es unliteral de fecha, el año, si se especifica, pasará a ser una parte permanente de la fecha. Sin embargo, si fecha1 o fecha2 está comprendida entre comillas dobles ("") y se omite el año, se insertará el año en curso en el código cada vez que se evalúe la expresión fecha1 o fecha2. Así es posible escribir código que se pueda usar en años distintos.
Cuando compara el 31 de diciembre con el 1 de enero del año siguiente, DateDiff para un año ("yyyy") devolverá 1 aunque sólo haya pasado un día.
Gracias y lamento no agradarte te creaste de mi una idea que nada que ver, muy completo tu aporte! estuve provando pero no encuentro la manera por que en realidad no tengo que calcular ninguna fecha sino convertir una fecha desde este formato 10/12/2010 a este 0344 y luego viceversa al leer el codigo de barras extraer los 4 digitos (0344) y convertir la fecha al formato 10/12/2010
-
@MIKE
Como que en 4 digitos?
La conversion de 12/10/12 seria igual que la de 12/10/62...
Option Explicit
Private Function CJulian(ByVal myDate As Date) As String
CJulian = Format$(myDate, "yy") & Format$((myDate - DateValue("1/1/" & Year(myDate)) + 1), "000")
End Function
Private Sub Command1_Click()
Debug.Print CJulian(CDate(Text1.Text))
End Sub
DoEvents! :P
Si 4 digitos! 10/12/2010 seria >>> 0344 (4 digitos) Y no es un capricho estoy en busca de ese algoritmo por que la exigencia de mi cliente es que la fecha solo tenga 4 digitos segun el calendario juliano (http://es.wikipedia.org/wiki/Fecha_juliana)
Y respecto a tu aporte de acortar la función está perfecto por lo menos con algunas pruebas que le hice sólo que me devuelve la fecha en 5 digitos.
Estoy comenzando a dudar que se pueda representar la fecha en 4 digitos hoy domingo llevo buscando 3 horas y me estoy ..........
Cualquier novedad la voy a informar para que quede registrado.
-
por lo que yo veo eso al hacer la reversa no hay forma de calcular el año solo si se comprende que ablamos de una decada en comun. vos solo pones el primer dijito del año por lo cual al revertir la funcion no te nunca vas a saber el año exacto.
Estas seguro que ese metodo esta bien? mas aya de que sean 5 o 4 dijitos?
-
.
Hasta ahora todas las fechas Julianas que he visto eran de 5 digitos, pero bueno... :P
Basado en tu funcion te dejo la mia simplificada al maximo(incluye comprobacion de año bisiesto y el problema que tenias conl os ceros):
Option Explicit
Private Function CJulian4(ByVal MyDate As Date) As String
CJulian4 = Right$(CStr(Year(MyDate)), 1) & IIf(CLng(Day(MyDate)) < 10, "0", vbNullString) & CStr(CLng(Day(MyDate)) + IIf((Day(DateSerial(Year(MyDate), 2, 29)) = 29), 1, 0) + Choose(CLng(Month(MyDate)), 31, 59, 90, 120, 151, 181, 212, 242, 273, 303, 333, 364))
End Function
Private Sub Command1_Click()
Debug.Print CJulian4(CDate(Text1.Text))
End Sub
DoEvents! :P
-
amigo bueno es un poco confuso de entender de forma sinplificada la verdad y una solucion un poco tirada de mi parte esta aqui, solo la primera parte la segunda ya es tarea tuya, te daras cuenta que saco dos tipos de dato para el anio y es para poder almacenar en la base de datos esto y luego poder pasar de juliana a normal ok, adjunto link para que veas.
http://rapidshare.com/files/435158241/datejuliana.rar (http://rapidshare.com/files/435158241/datejuliana.rar)
espero serte de ayuda amigo
Private Sub cmdCommand1_Click()
Call julian
End Sub
Private Sub d1_Change()
On Error Resume Next
t1.Text = d1.Value
End Sub
Private Sub Form_Load()
t1.Text = d1.Value
End Sub
Public Sub julian()
Dim jdday, jdmon, jdyear, jdyearreal, juliandate
'leemos desde la caja de texto y no del dtpicker
jdday = Mid$(t1.Text, 1, 2)
jdmon = Mid$(t1.Text, 4, 2)
jdyear = Mid$(t1.Text, 10, 2)
jdyearreal = Mid$(t1.Text, 9, 2)
Jan = 31
Feb = 28
Mar = 31
Apr = 30
May = 31
Jun = 30
jul = 31
Aug = 31
sep = 30
Otb = 31
Nov = 30
Dec = 31
'limpiamos la valiable
juliandate = 0
Select Case jdmon
Case "01" 'jan
juliandate = jdday
Case "02" 'feb
juliandate = jdday + Jan
Case "03" 'mar
juliandate = jdday + Jan + Feb
Case "04" 'apr
juliandate = jdday + Jan + Feb + Mar
Case "05" 'may
juliandate = jdday + Jan + Feb + Mar + Apr
Case "06" 'jun
juliandate = jdday + Jan + Feb + Mar + Apr + May
Case "07" 'jul
juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun
Case "08" 'aug
juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul
Case "09" 'sep
juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul + Aug
Case "10" 'oct
juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul + Aug + sep
Case "11" 'nov
juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul + Aug + sep + Otb
Case "12" 'dec
juliandate = jdday + Jan + Feb + Mar + Apr + May + Jun + jul + Aug + sep + Otb + Nov
End Select
´formateamos el dato a nuestra necesidad en este caso 4 digitos
juliandate = jdyear + Format(juliandate, "000")
MsgBox juliandate
End Sub
-
http://media.skyandtelescope.com/binary/caljd.bas
http://media.skyandtelescope.com/binary/jdcal.bas
Estan en basic pero no es muy difical convertirlos.
-
Huy gracias cuantas respuesta! ahora me pongo a mirar todo y posteo luego la solucion!!
Gracias muchachos!
-
Hola a todos!
Para el que le interese solucioné el problema al fin!!
El tema de la fecha JULIANA que necesitaba representar en 4 Digitos es así el primer basándome en la fecha de hoy 07/12/2010 y transformada a 4 dígitos es 0341 , el 1º dígito (0) representa al año 2010 y los otros 3 restantes son los días trascurridos desde el 1º de enero o sea que hoy está transcurriendo el dia 341.
Uno puede pensar que el 0 que representa al año 2010 podría interpretarse como por ejemplo el año 2000 lo que si se utiliza la rutina que abajo coloco da exactamente el mismo numero 07/12/2000 = 0341 . Pero el sistema que lee estos números se actualiza cada 10 años y no lee hacia atrás.
Bueno tal vezz algunos no me entiendan por que se trata de un desarrollo especifico que me solicitaron pero si a alguien le sirve pongo abajo el codigo completo que devuelve los 4 digitos de la fecha pasada como parámetro.
Private Function Convert(fecha As String) As String
Dim JdMes As String
Dim JdDia As String
Dim JdAño As String
Dim ENE As Integer
Dim FEB As Integer
Dim MAR As Integer
Dim ABR As Integer
Dim MAY As Integer
Dim JUN As Integer
Dim JUL As Integer
Dim AGO As Integer
Dim SEP As Integer
Dim OCT As Integer
Dim NOV As Integer
Dim DIC As Integer
Dim JulianDate As String
Dim LeapYears As String
JdDia = Format$(Day(fecha), "00")
JdMes = Format$(Month(fecha), "00")
JdAño = Format$(Year(fecha), "0000")
ENE = 31
'COMPROBACION DE AÑO BICIESTO
If Comprobar(JdAño) Then
FEB = 29
Else
FEB = 28
End If
'
MAR = 31
ABR = 30
MAY = 31
JUN = 30
JUL = 31
AGO = 31
SEP = 30
OCT = 31
NOV = 30
DIC = 31
LeapYears = DateSerial(JdAño, JdMes, JdDia)
Select Case JdMes
Case "01" 'ENE
JulianDate = JdDia
Case "02" 'FEB
JulianDate = JdDia + ENE
Case "03" 'MAR
JulianDate = JdDia + ENE + FEB
Case "04" 'ABR
JulianDate = JdDia + ENE + FEB + MAR
Case "05" 'MAY
JulianDate = JdDia + ENE + FEB + MAR + ABR
Case "06" 'JUN
JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY
Case "07" 'JUL
JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN
Case "08" 'AGO
JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL
Case "09" 'SEP
JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL + AGO
Case "10" 'oct
JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL + AGO + SEP
Case "11" 'NOV
JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL + AGO + SEP + OCT
Case "12" 'DIC
JulianDate = JdDia + ENE + FEB + MAR + ABR + MAY + JUN + JUL + AGO + SEP + OCT + NOV
End Select
Dim tmp
tmp = JulianDate
tmp = Right(JdAño, 1) & JulianDate
Convert = Right$("0000" & tmp, 4)
End Function
' función que comprueba si el año es bisiesto
'''''''''''''''''''''''''''''''''''''''''''''
Public Function Comprobar(Año As Variant) As Boolean
If VarType(Año) = vbDate Then
Comprobar = (Day(DateSerial(Year(Año), 2, 29)) = 29)
Else
Comprobar = (Day(DateSerial(Año, 2, 29)) = 29)
End If
End Function
Muchas gracias a todos los que me ayudaron!!
-
Hola yo creo que entre lo que te dijo wolf_kof y algo de lo que puso Mr. Frog podrias resumir toda esa función en una linea
Private Function FechaJuliana(ByVal Fecha As Date) As String
FechaJuliana = Right$(Year(Fecha), 1) & Format$(DateDiff("D", "01/01/" & Year(Fecha), Fecha) + 1, "000")
End Function
Saludos.
-
Hola yo creo que entre lo que te dijo wolf_kof y algo de lo que puso Mr. Frog podrias resumir toda esa función en una linea
Private Function FechaJuliana(ByVal Fecha As Date) As String
FechaJuliana = Right$(Year(Fecha), 1) & Format$(DateDiff("D", "01/01/" & Year(Fecha), Fecha) + 1, "000")
End Function
Saludos.
Cierto Leandro lo que pasa es que en al apuro por concluir esto me habia dlo deje asi nomas como la tenia pero ya esta cambiada por la simplificada al maximo! .
De nuevo gracias a todos