Extraer palabra de una cadena de caracteres
El campo Artículo siempre comienza en mayúscula y es la marca del artículo. A veces puede estar compuesta por dos palabras, siempre en mayúscula. Lo que quiero es que al clikear el botón de opción catálogo, y sea verdadero me copie la descripción del artículo sin la marca en el campo de abajo que se llama Nombre_basico (Nombre catálogo).
El código que utilizo me lo copia entero y no sé como puede discriminar la o las dos primeras palabras en mayúscula.
Es el siguiente;
Si pudieran ayudadme se lo agradecería.
Requiere código de VBA, puede utilizar las siguientes funciones (Adiciónelas a un módulo de VBA)
Public Function sin_mayuscula(strFrase As String) As String
'Función para quitar la 1ra y 2gda palabras mayúsculas de una frase
'Ejemplo:
' sin_mayuscula("BOGOTA está en Colombia") --- retorna está en Colombia
' sin_mayuscula("BOGOTA ESTA en Colombia") ---- retorna en Colombia
'
' Requiere de las funciones:
' ctamayuscula()
' extrae()
' contar_palabras()
' NOTA: Se considera que la cadena o frase tiene más de 2 palabras
' Ejemplo de llamada:
' sin_mayuscula("INDEX tirafondo de cabeza avellanada 4 x 35(Caja 500 UD)Huella PZ")
' Retorna: sin_mayuscula("INDEX tirafondo de cabeza avellanada 4 x 35(Caja 500 UD)Huella PZ")
' Elaborado por: Eduardo Pérez Fernández
' Fecha: 9/1/2022
Dim lnPalabras As Integer
Dim aux1 As String
Dim aux2 As String
Dim boolMayus1 As Boolean
Dim boolMayus2 As Boolean
Dim tem As Integer
lnPalabras = contar_palabras(strFrase)
If lnPalabras <=2 Then
sin_mayuscula = strFrase
Exit Function
End If
'Contar
If lnPalabras >= 3 Then
aux1 = extrae(strFrase, 1, " ") 'Primera palabra
aux2 = extrae(strFrase, 2, " ") 'Segunda palabra
boolMayus1 = ctamayuscula(aux1)
boolMayus2 = ctamayuscula(aux2)
If boolMayus1 = True And boolMayus2 = True Then
tem = InStr(1, strFrase, aux2) + Len(aux2)
sin_mayuscula = Trim(Mid(strFrase, tem, Len(strFrase) - tem + 1))
Exit Function
ElseIf boolMayus1 = True And boolMayus2 = False Then
tem = InStr(1, strFrase, aux1)
sin_mayuscula = Trim(Mid(strFrase, Len(aux1) + 1, Len(strFrase) - tem + 1))
Else
sin_mayuscula = strFrase
End If
End If
End Function
Public Function ctamayuscula(strCadena As String) As Boolean
'Función para extraer texto si la palabara es mayúscula
Dim strAux1 As String
Dim intCadena As Integer
Dim x As Integer
Dim y As Integer
intCadena = Len(strCadena)
For x = 1 To intCadena
If Asc(Mid(strCadena, x, 1)) >= 65 And Asc(Mid(strCadena, x, 1)) <= 90 Then
y = y + 1
End If
Next x
If y = intCadena Then 'Todas las letras son mayúsculas
ctamayuscula = True
Else
ctamayuscula = False
End If
End Function
Public Function extrae(pvstring As Variant, pipart As Integer, Optional psDeli As String = ",")
'Functión para extraer parte de una cadena
'Parámetros:
' pvstring=Cadena de texto a minipular
' pipart=Parte de cadena a extraer de acuerdo con el separador,
' por ejemplo,1 primera parte, 2 segunda parte
' psdeli=Separador, opcional por defecto coma (,) pero pueder otro como guion(-)
'Elaborada por: Eduardo Pérez Fernández
'Fecha: 06/09/2021
'Ejemplos de llamada:
'? Extrae("Eduardo, Pérez", 1,",") ------>> retorna Pérez elimina el espacio que hay antes de Pérez
'? Extrae(", Pérez", 2,",") ------>> retorna Pérez elimina el espacio que hay antes de Pérez
'? Extrae("Eduardo-Pérez", 2,"-") ------>> retorna Pérez. Observe que cambie el separador de cadena por -
'? Extrae("Eduardo, Pérez", 2) ------>> retorna Pérez. No inclui el separador toma el separador por defecto,
'? Extrae("Eduardo, Pérez, Fernández", 3) ----->> retorna el segundo apellido Fernández
On Error Resume Next
extrae = Null
If Mid(pvstring, 1, 1) = psDeli Then
pvstring = "nd" & pvstring
End If
If IsNull(pvstring) Then Exit Function
extrae = Trim(Split(pvstring, psDeli)(pipart - 1))
End Function
'---------------------------
Function contar_palabras(strPalabras As String)
'Función para contar las palabras en una frase
'Ej. contar_palabras("Mi hermano del alma"
'Retorna 4
Dim WrdArray() As String
WrdArray() = Split(strPalabras)
contar_palabras = UBound(WrdArray()) + 1
End FunctionEl proceso es el siguiente:
1. Contar las palabras que tiene la frase, lo hago con la función contar_palabras()
2. Si son menos de 3 palabras retorna la misma frase, igualmente si son más de 3 pero la primera y segunda palabra están en minúsculas.
3. Si son 3 o más palabras en la frase extraigo de la frase las 2 primeras palabras para analizarlas si todos los caracteres están en mayúsculas, esto lo hago con la función extraer()
4. Con la función ctamayuscula() obtengo un valor booleano que me indica si todos lo caracteres de la palabra están en mayúscula.
En el evento opcion_click() en la línea:
Nombre_basic=Me.Artículo --- cambiéla por
Nombre_basic=sin_mayuscula(Me.Artículo)
Puede que exista otra forma y mejor pero está la he probado y funciona con la condición que solo sirve para evaluar las 2 primeras palabras de la frase están en mayúsculas.
Para responder burradas y copiar la idea de otro se puede utilizar 1 línea, la pregunta es muy clara "A veces puede estar compuesta por dos palabras, siempre en mayúscula", no dice la primera letra de cada palabra y esto es lo que interpreta el inexperto, en consecuencia se deben hacer las validaciones respectivas, en casto contrario con el código de "solo 8 líneas" se pueden cometer los siguientes errores, estos son algunos ejemplos: (El resaltado es la respuesta del código de 8 líneas que no sirven para nada)
1. Bogotá ESTa en Colombia
ESTa en Colombia
Error: La primera y segunda palabra no está en mayúsculas
2. Bogotá ESTa
ESTa
Error: Solo hay 2 palabras y deben ser más mayor que 2
3. Bogotá ESTA en colombia
En colombia
Error: La primera palabra no está en mayúsculas
4. BOGOTÁ ESTa en Colombia
En Colombia
Error: La segunda palabra no está en mayúsculas
Para evitar estos errores no es posible limitarnos a la propuesta del genio de 8 líneas.
Resumiendo si hay caminos más cortos, pero este nos puede llevar a un precipicio.
No tenga en cuenta los acentos, los cuales se cambiaron al enviar la respuesta, es decir, cambie BOGOTÁ por BOGOTA.
Para considerar los acentos de letras mayúsculas cambie la función ctamayuscula() por esta:
Public Function ctamayuscula(strCadena As String) As Boolean 'Función para extraer texto si la palabara es mayúscula Dim strAux1 As String Dim intCadena As Integer Dim x As Integer Dim y As Integer intCadena = Len(strCadena) For x = 1 To intCadena Select Case Asc(Mid(strCadena, x, 1)) Case 65 To 90 y = y + 1 Case 193, 201, 205, 211, 218 y = y + 1 End Select Next x If y = intCadena Then 'Todas las letras son mayúsculas ctamayuscula = True Else ctamayuscula = False End If End Function
Observe el resultado de este ejemplo con la función de "8 líneas" y el código de la función propuesta:
Vaya respuesta que te dan...
Para controlar las palabras con acentos cambie la función ctamayuscula() por esta:
Public Function ctamayuscula(strCadena As String) As Boolean 'Función para extraer texto si la palabara es mayúscula Dim strAux1 As String Dim intCadena As Integer Dim x As Integer Dim y As Integer intCadena = Len(strCadena) For x = 1 To intCadena Select Case Asc(Mid(strCadena, x, 1)) Case 65 To 90 y = y + 1 Case 193, 201, 205, 211, 218 y = y + 1 End Select Next x If y = intCadena Then 'Todas las letras son mayúsculas ctamayuscula = True Else ctamayuscula = False End If End Function
Observe este ejemplo:
! Vaya respuesta de tan solo 8 líneas...! Si quiere el ejemplo puede solicitarlo a [email protected] favor anotar en el asunto la consulta.
1 respuesta más de otro experto
Vaya respuesta que te dan. Dices que siempre, al menos, la primera o las dos primeras palabras van en mayúscula. Si en un cuadro de texto tengo
Cuando pulso el botón
En otro caso
Al pulsarlo
Ítem más, en caso de que no hubiera ninguna
En código ASCII, las letras mayúsculas tiene diferente valor que las minúsculas, por tanto basta con comprobar si la segunda letra de cada palabra está en mayúsculas o minúsculas. Si está en mayúsculas se elimina esa cadena. Si está en minúsculas se deja. En caso de que El código del botón es simplemente
Private Sub Comando7_Click() If Asc(Mid([Cadena], 2, 1)) >= 65 And Asc(Mid([Cadena], 2, 1)) <= 90 Then Texto5 = Mid([Cadena], InStr([Cadena], " ") + 1) If Asc(Mid([Texto5], 2, 1)) >= 65 And Asc(Mid([Texto5], 2, 1)) <= 90 Then Texto5 = Mid([Texto5], InStr([Texto5], " ") + 1) End If Else Texto5 = Cadena End If End Sub
¡¡Sólo 8 líneas de código!!
El primer If, elimina la primera palabra en mayúsculas, y en caso de que haya dos, el segundo if la elimina, si no hay lo deja como está.