Estas son algunas de las funciones y procedimientos que suelo usar de forma genérica en mis programas.
Aquí no incluyo las que ya están puestas... (algún día lo haré, aunque sea mediante links a dónde están).
- Quitar de una cadena los Caracteres indicados.
- Rellenar una cadena con caracteres hasta completar una longitud dada
- Formatear un número a una longitud dada y cambiar los signos de puntuación al indicado
- Cálculo de la letra del NIF
- Cambiar los caracteres extraños por ? (para usar en las consultas a bases de datos con LIKE)
Quitar de una cadena los Caracteres indicados.
Esta función recibe dos cadenas, la primera es la que se quiere procesar y la segunda los caracteres que se quieren quitar de la primera, ésta última al ser opcional, si no se indica se asume que son los caracteres: punto, coma y espacio.
NOTA: Si quieres ver otra versión de esta función para sustituir ciertos caracteres por otros, pulsa este link.
Ejemplo:
sRet$ = QuitarCaracter("Hola Mundo", "Mundo ")
Devolverá: "Hla"
No es un fallo, es que comprueba los caracteres uno a uno.Public Function QuitarCaracter(ByVal sValor As String, Optional sCaracter) As String '---------------------------------------------- ' Quitar los símbolos ( 5/Jun/96) '---------------------------------------------- Dim i As Integer Dim j As Integer Dim sTmp As String 'Si no se especifican los caracteres a quitar If IsMissing(sCaracter) Then sCaracter = "., " 'Para números End If sTmp = "" For i = 1 To Len(sValor) If InStr(sCaracter, Mid$(sValor, i, 1)) = 0 Then sTmp = sTmp & Mid$(sValor, i, 1) End If Next QuitarCaracter = sTmp End Function
Rellenar una cadena con caracteres hasta completar una longitud dada.
Esta función devolverá una cadena con la longitud indicada en el segundo parámetro, el tercer parámetro se usa para justificarla de tres formas posibles: izquierda (0), derecha (1), centrado (2)
Si la longitud original de la cadena es mayor que lo especificado en el segundo parámetro, y éste es mayor que cinco, se mostrarán tres puntos suspensivos, para avisar que lo que se muestra no es todo lo que hay...Public Function Rellena(ByVal sCadena As String, iLen As Integer, Optional DerIzq) As String 'Si no se especifica DerIzq, se justifica a la Izquierda (20/Oct/96) 'Si se especifica, un valor 0 lo justifica a la Izquierda, otro cualquiera a la Derecha 'Izquierda 0 (vbLeftJustify), Derecha 1 (vbRightJustify), Centrado 2 (vbCenter) ' Dim sTmp As String Dim vDerIzq As Integer sTmp = Space$(iLen) If IsMissing(DerIzq) Then vDerIzq = vbLeftJustify Else vDerIzq = CInt(DerIzq) End If sCadena = Trim$(sCadena) 'Si no se va a mostrar todo y 'la longitud a mostrar es mayor de 5, mostrar 3 puntos al final If (Len(sCadena) > iLen) And (iLen > 5) Then sCadena = Left$(sCadena, iLen - 3) & "..." End If If vDerIzq = vbRightJustify Then RSet sTmp = sCadena ElseIf vDerIzq = vbLeftJustify Then LSet sTmp = sCadena Else 'Centrado sTmp = sCadena Do While Len(sTmp) < iLen sTmp = " " & sTmp & " " Loop sTmp = Left$(sTmp, iLen) End If Rellena = sTmp End Function
Formatear un número a una longitud dada y cambiar los signos de puntuación al indicado.
Esta función la uso para simular el Format$, realmente la hice cuando trabaja con QuickBasic y no existía esa función, de todas formas esta función siempre devuelve cadenas de la longitud especificada en el segundo parámetro.
Si no quieres que el signo de puntuación sea el punto, cambia la constante cSigno para que tenga el valor adecuado.
Si la longitud especificada es un valor negativo, se mostrará el número con la letra D o H, dependiendo del valor.
(esto es fácil de quitar y yo lo tenía para la aplicación de Contabilidad)
Nota: Sólo funciona con números enteros y realmente es para "separar" los miles.Function PuntoComa(strAs As String, iLoi As Integer, Optional vRelleno) As String '---------------------------------------------- 'Si lo<0 mostrar " D" o " H" después del número (24/Ene/91) 'Para Visual Basic Windows (30/Abr/96) ' (31/May/96) 'Si se especifica vRelleno, se rellena con ese 'caracter el principio de la cadena resultante. '---------------------------------------------- Const cSIGNO = "." Dim bDebHab As Boolean Dim lngA As Long Dim iSigDH As Integer Dim strQ As String Dim strB As String Dim le As Integer Dim j As Integer Dim a As Integer Dim iLo As Integer Dim strA As String If IsNull(strAs) Then strA = "0" Else strA = strAs End If iLo = iLoi bDebHab = False If iLo < 0 Then bDebHab = True iLo = iLo * (-1) - 2 End If lngA = Val(strA) iSigDH = 0 If lngA < 0& Then iSigDH = -1 ElseIf lngA > 0& Then iSigDH = 1 End If If bDebHab Then lngA = Abs(lngA) strQ = Str$(lngA) strA = strQ If Abs(Val(strQ)) > 999 Then strQ = LTrim$(RTrim$(strQ)) le = Len(strQ) strA = "" j = 0 For a = le To 1 Step -1 strB = Mid$(strQ, a, 1) If strB <> " " Then strA = strB + strA: j = j + 1 If j = 3 Then strA = cSIGNO + strA: j = 0 End If Next While Left$(strA, 1) = cSIGNO strA = Mid$(strA, 2) Wend While Left$(strA, 2) = "-" + cSIGNO strA = Left$(strA, 1) + Mid$(strA, 3) Wend 'Si la longitud es mayor, quitar el cSIGNO de puntuación If Len(strA) > iLo Then Do j = InStr(strA, cSIGNO) If j Then strA = Left$(strA, j - 1) + Mid$(strA, j + 1) Else Exit Do End If Loop End If Else strA = strQ End If If bDebHab Then If iSigDH < 0 Then strQ = " D" ElseIf iSigDH > 0 Then strQ = " H" Else strQ = " " End If strA = strA + strQ iLo = iLo + 2 End If strQ = Right$(Space$(iLo) + strA, iLo) If Not IsMissing(vRelleno) Then For a = 1 To Len(strQ) If Mid$(strQ, a, 1) = " " Then Mid$(strQ, a, 1) = vRelleno Else Exit For End If Next End If PuntoComa = strQ End Function
Cálculo de la letra del NIF.
Esta función recibirá una cadena con un valor y la devolverá añadiendo al final la letra correspondiente.
Si la cadena recibida tiene signos de puntuación, etc., los quitará, realmente sólo deja los números.
Sé que se puede calcular de otra forma más fácil, pero es la que uso desde hace años, la fecha indicada es de cuando la adapté al Visual Basic.Private Sub CalculaNIF(strA As String) '-------------------------------------------------------- 'Calcular la letra del NIF (13/Sep/95) '-------------------------------------------------------- Const cCADENA = "TRWAGMYFPDXBNJZSQVHLCKE" Const cNUMEROS = "0123456789" Dim strT As String, strB As String Dim a#, NIF#, b#, c# Dim i As Integer strT = Trim$(strA) If Len(strT) = 0 Then Exit Sub strB = "" '---Dejar sólo los números... For i = 1 To Len(strA) If InStr(cNUMEROS, Mid$(strA, i, 1)) Then strB = strB + Mid$(strA, i, 1) End If Next strA = strB a# = 0 NIF# = Val(strA) Do b# = Int(NIF# / 24) c# = NIF# - (24 * b#) a# = a# + c# NIF# = b# Loop While b# <> 0 b# = Int(a# / 23) c# = a# - (23 * b#) strA = Trim$(strT) + "-" + Mid$(cCADENA, c# + 1, 1) End Sub
Cambiar los caracteres extraños por ? (para usar en las consultas a bases de datos con LIKE).
Este procedimiento lo uso para las consultas a las bases de datos. De esta forma 'filtro' los caracteres extraños con el signo de interrogación, siempre que realice la comparación con LIKE, ya que la interrogación sirve para indicarle que es cualquier cosa.
Private Sub ChequearCadena(sCadena As String) 'Comprobar si hay signos no alfabéticos Dim i As Integer Dim j As Integer Dim sCheq As String 'En sCheq estarán todos los signos que no sean 'letras y Espacio (32), # (35), *(42), ?(63) sCheq = Chr$(33) & Chr$(34) For j = 36 To 41 sCheq = sCheq & Chr$(j) Next For j = 43 To 62 sCheq = sCheq & Chr$(j) Next sCheq = sCheq & Chr$(64) For j = 91 To 96 sCheq = sCheq & Chr$(j) Next For j = 123 To 159 sCheq = sCheq & Chr$(j) Next '160 es un espacio For j = 161 To 255 sCheq = sCheq & Chr$(j) Next 'La mayoría de los caracteres de 192 a 255 son acentuadas 'y las compara igual que las normales 'Ahora no, porque hace una comparación binaria. For i = 1 To Len(sCadena) 'Obligar a comparar de forma binaria ----v j = InStr(1, sCheq, Mid$(sCadena, i, 1), 0) If j Then Mid$(sCadena, i, 1) = "?" End If Next End Sub