Excel Macro(?) convert text string to date Closed

Question

Hello,
Maybe this problem is trivial to solve, but I haven't done anything with Excel Macros since University and that was long time ago. Maybe macros aren't even needed.

So, there is one column with ~5000 records, everyone of which all consist of 11 numbers (like 21019910614 ). It is personal identifier in my country and begins with date (in previous example it would look like 21.01.99 - dd.mm.yy ) Other 5 numbers are like ID number.
What is needed? From all these 5000 Records I need to remove last 5 (because I need just date ones) numbers and all remaining turn into Date Format (like I wrote - dd.mm.yy). It is the first part and if we could find any solution to make these records to dates, it would be great.

Hope, I explained the problem enough.

WutUp WutUp · Answer

This assumes that the data is in column A and that row 1 has header info. So, it starts checking in row 2 of
column A. Also, by using the Do loop until empty assumes there are no blank cells in the column. Otherwise,
the For loop will need to be used.

Hope this helps!

Sub CreateDate()

Dim j
j = 2

Do Until Range("A" & j) = ""

    Range("A" & j) = Left(Range("A" & j), 2) & "." & Mid(Range("A" & j), 3, 2) & "." & Mid(Range("A" & j), 5, 2)
    
j = j + 1

Loop


End Sub

noecortez · Answer

Puedes utilizar el siguiente codigo, solo tecleas ALT+F11 y le das insertar - modulo. Copias el siguiente codigo:
Function ntot(Numero)
Dim Texto
Dim Millones
Dim Miles
Dim Cientos
Dim Decimales
Dim Cadena
Dim CadMillones
Dim CadMiles
Dim CadCientos
Texto = Numero
Texto = FormatNumber(Texto, 2)
Texto = Right(Space(14) & Texto, 14)
Millones = Mid(Texto, 1, 3)
Miles = Mid(Texto, 5, 3)
Cientos = Mid(Texto, 9, 3)
Decimales = Mid(Texto, 13, 2)
CadMillones = ConvierteCifra(Millones, 1)
CadMiles = ConvierteCifra(Miles, 1)
CadCientos = ConvierteCifra(Cientos, 0)
If Trim(CadMillones) > "" Then
If Trim(CadMillones) = "UN" Then
Cadena = CadMillones & " MILLON"
Else
Cadena = CadMillones & " MILLONES"
End If
End If
If Trim(CadMiles) > "" Then
Cadena = Cadena & " " & CadMiles & " MIL"
End If
If Trim(CadMiles & CadCientos) = "UN" Then
Cadena = Cadena & "UNO CON " & Decimales & "/100"
Else
If Miles & Cientos = "000000" Then
Cadena = Cadena & " " & Trim(CadCientos) & " DE PESOS " & Decimales & "/100"
Else
Cadena = Cadena & " " & Trim(CadCientos) & " PESOS " & Decimales & "/100"
End If
End If
ntot = "(" + Trim(Cadena) + ")"
End Function

Function ConvierteCifra(Texto, SW)
Dim Centena
Dim Decena
Dim Unidad
Dim txtCentena
Dim txtDecena
Dim txtUnidad
Centena = Mid(Texto, 1, 1)
Decena = Mid(Texto, 2, 1)
Unidad = Mid(Texto, 3, 1)
Select Case Centena
Case "1"
txtCentena = "CIEN"
If Decena & Unidad <> "00" Then
txtCentena = "CIENTO"
End If
Case "2"
txtCentena = "DOSCIENTOS"
Case "3"
txtCentena = "TRESCIENTOS"
Case "4"
txtCentena = "CUATROCIENTOS"
Case "5"
txtCentena = "QUINIENTOS"
Case "6"
txtCentena = "SEISCIENTOS"
Case "7"
txtCentena = "SETECIENTOS"
Case "8"
txtCentena = "OCHOCIENTOS"
Case "9"
txtCentena = "NOVECIENTOS"
End Select

Select Case Decena
Case "1"
txtDecena = "DIEZ"
Select Case Unidad
Case "1"
txtDecena = "ONCE"
Case "2"
txtDecena = "DOCE"
Case "3"
txtDecena = "TRECE"
Case "4"
txtDecena = "CATORCE"
Case "5"
txtDecena = "QUINCE"
Case "6"
txtDecena = "DIECISEIS"
Case "7"
txtDecena = "DIECISIETE"
Case "8"
txtDecena = "DIECIOCHO"
Case "9"
txtDecena = "DIECINUEVE"
End Select
Case "2"
txtDecena = "VEINTE"
If Unidad <> "0" Then
txtDecena = "VEINTI"
End If
Case "3"
txtDecena = "TREINTA"
If Unidad <> "0" Then
txtDecena = "TREINTA Y "
End If
Case "4"
txtDecena = "CUARENTA"
If Unidad <> "0" Then
txtDecena = "CUARENTA Y "
End If
Case "5"
txtDecena = "CINCUENTA"
If Unidad <> "0" Then
txtDecena = "CINCUENTA Y "
End If
Case "6"
txtDecena = "SESENTA"
If Unidad <> "0" Then
txtDecena = "SESENTA Y "
End If
Case "7"
txtDecena = "SETENTA"
If Unidad <> "0" Then
txtDecena = "SETENTA Y "
End If
Case "8"
txtDecena = "OCHENTA"
If Unidad <> "0" Then
txtDecena = "OCHENTA Y "
End If
Case "9"
txtDecena = "NOVENTA"
If Unidad <> "0" Then
txtDecena = "NOVENTA Y "
End If
End Select

If Decena <> "1" Then
Select Case Unidad
Case "1"
If SW Then
txtUnidad = "UN"
Else
txtUnidad = "UNO"
End If
Case "2"
txtUnidad = "DOS"
Case "3"
txtUnidad = "TRES"
Case "4"
txtUnidad = "CUATRO"
Case "5"
txtUnidad = "CINCO"
Case "6"
txtUnidad = "SEIS"
Case "7"
txtUnidad = "SIETE"
Case "8"
txtUnidad = "OCHO"
Case "9"
txtUnidad = "NUEVE"
End Select
End If
ConvierteCifra = txtCentena & " " & txtDecena & txtUnidad
End Function

Luego lo mandas llamar desde tu hoja como =ntot(B15), por ejemplo donde B15 es la celda donde esta el numero que quieres convertir a texto.
Para cualquier otro desarrollo estoy a tus ordenes, me puedes escribir a noecortez(arroba)leipzig.com.mx o llamarme al 011+52+55+55654892

Excel Macro(?) convert text string to date

2 responses

Similar discussions

Subscribe To Our Newsletter!