Autor
|
Tema: [SRC] + [Función] Text_Between_Words [by *PsYkE1*] (Leído 6,675 veces)
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
ATENCION: SRC CORREGIDOHola, aqui os dejo esta funcin que acabo de hacer, no es gran cosa, pero bueno... ' //////////////////////////////////////////////////////////////// ' // *Autor: *PsYkE1* (miguelin.majo@gmail.com) // ' // *Podeis agrandar o reducir el codigo, siempre y cuando se // ' // respete la autoria y se me comuniquen esos cambios. // ' // *Agradecimientos a BlackZeroX & Cobein // ' // *Visita http://foro.rthacker.net // ' //////////////////////////////////////////////////////////////// Option Explicit Public Function Text_Between_Words(ByVal sTextToAnalyze As String, ByVal sStartWord As String, ByVal sEndWord As String) As String Dim iPosition1 As Integer Dim iPosition2 As Integer Dim iStart As Integer iPosition1 = InStr(sTextToAnalyze, sStartWord) If iPosition1 <> 0 Then iStart = iPosition1 + Len(sStartWord) iPosition2 = InStr(iStart, sTextToAnalyze, sEndWord) Else Exit Function End If If iPosition2 <> 0 Then Text_Between_Words = Mid$(sTextToAnalyze, iStart, iPosition2 - iStart) End If End Function
Un ejemplo seria asi: El contexto es el ámbito de referencia de un texto. ¿Qué entiendo por ámbito de referencia?. Debug.Print Text_Between_Words(Text1.Text, "referencia", "entiendo")
El resultado seria: de un texto. ¿Qué Y si pongo esto: Debug.Print Text_Between_Words(Text1.Text, "referencia", "referencia")
Me sale esto: de un texto. ¿Qué entiendo por ámbito de Espero que os haya gustado(mas aun )... Salu2!
|
|
« Última modificación: 6 Julio 2010, 19:40 pm por *PsYkE1* »
|
En línea
|
|
|
|
ssccaann43 ©
Desconectado
Mensajes: 792
¬¬
|
Muy bueno *PsYkE1*, me gustó...!
|
|
|
En línea
|
- Miguel Núñez Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio... "I like ^TiFa^"
|
|
|
Elemental Code
Desconectado
Mensajes: 622
Im beyond the system
|
me costo entender como andaba asi que voy a explicarlo otra vez. Si en la caja de texto escribo No entendi el codigo y por eso hago esto y llamo a la funcion como MsgBox Text_Between_Words(Text1.Text, "Codigo", "Esto")
me responde: Esta bueno pero si lo hiciste vos porque esta en ingles el mensaje de error :S... Ademas. Para que sirve?? Muy bueno para aprender como usar el instr que no sabia que existia y para practicar pero no entendi del todo para que sirve Toda la onda
|
|
|
En línea
|
I CODE FOR $$$ Programo por $$$ Hago tareas, trabajos para la facultad, lo que sea en VB6.0 Mis programas
|
|
|
ssccaann43 ©
Desconectado
Mensajes: 792
¬¬
|
Me intrigo eso de que el mensaje esta en ingles...! *PsYkE1*, no lo tomes a mal, pero detesto a los Copy&Paste...! Espero que esa funcion sea 100% tuya... Sino, tomate este momento para colocar su autor...!
|
|
|
En línea
|
- Miguel Núñez Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio... "I like ^TiFa^"
|
|
|
ssccaann43 ©
Desconectado
Mensajes: 792
¬¬
|
me costo entender como andaba asi que voy a explicarlo otra vez. Si en la caja de texto escribo No entendi el codigo y por eso hago esto y llamo a la funcion como MsgBox Text_Between_Words(Text1.Text, "Codigo", "Esto")
me responde: Esta bueno pero si lo hiciste vos porque esta en ingles el mensaje de error :S... Ademas. Para que sirve?? Muy bueno para aprender como usar el instr que no sabia que existia y para practicar pero no entendi del todo para que sirve Toda la onda Por cierto asi es como funciona Elemental, te muestra el texto que contiene una frase entre 2 palabras...!
|
|
|
En línea
|
- Miguel Núñez Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio... "I like ^TiFa^"
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Muy bueno *PsYkE1*, me gustó...! Gracias ssccaann43! me costo entender como andaba asi que voy a explicarlo otra vez. Si en la caja de texto escribo No entendi el codigo y por eso hago esto y llamo a la funcion como MsgBox Text_Between_Words(Text1.Text, "Codigo", "Esto")
me responde: Si, exacto, pero no te olvides de si la palabra lleva minusculas o MAYUSCULAS... MsgBox Text_Between_Words(Text1.Text, "codigo", "esto")
Esta bueno pero si lo hiciste vos porque esta en ingles el mensaje de error :S... Jajaja Pense que quedaria más internacional... Ademas. Para que sirve?? He posteado porque lo necesitaba para un proyecto que estoy haciendo, y pense que podia ser interesante... Salu2!
|
|
« Última modificación: 1 Junio 2010, 02:51 am por *PsYkE1* »
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Me intrigo eso de que el mensaje esta en ingles...! *PsYkE1*, no lo tomes a mal, pero detesto a los Copy&Paste...! Espero que esa funcion sea 100% tuya... Sino, tomate este momento para colocar su autor...! Te puedo asegurar que no es C&P ssccaann43... El mensaje lo puse en ingles con el Google traductor... Me desagrada que pienses eso... Prefiero subir una m**** de code (como ya he hecho en ocasiones) a hacer un C&P... Salu2!
|
|
|
En línea
|
|
|
|
ssccaann43 ©
Desconectado
Mensajes: 792
¬¬
|
Bueno, te pedi que no te molestaras ni lo tomes a mal...! Excelente entonces...! Un saludo...!
|
|
|
En línea
|
- Miguel Núñez Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio... "I like ^TiFa^"
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
. Dejen de decir C&P y opinen ("Eso diria si fuese el autor del hilo...") Dim pos1 as integer
Es pos1 o pos? para que no te sucedan estas cosas feas usa al inicio option explicit
* Lo peor que puedes hacer en una funcion es meterle un msgbox inputbox o X cosa SON ESTORBOS CREEME NO SON DINAMICOS. Por otra parte... Aqui esta mi funcion Entre Texto es "Anti-Error". ' ' //////////////////////////////////////////////////////////////// ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' //////////////////////////////////////////////////////////////// Option Explicit Public Function Entre_Texto(ByRef StrIn As String, ByVal StrIni As String, ByVal StrFin As String, Optional ComparacionEstricta As Boolean) As String Dim Pos(1) As Long Dim IniPos As Long Dim OptionalCompare As VbCompareMethod If Len(StrIn) > 0 Then If ComparacionEstricta Then OptionalCompare = vbBinaryCompare Else OptionalCompare = vbTextCompare End If Pos(0) = InStr(1, StrIn, StrIni, OptionalCompare) Pos(1) = InStr(1, StrIn, StrFin, OptionalCompare) If CBool(Pos(0)) And CBool(Pos(1)) And Pos(0) < Pos(1) Then IniPos = Pos(0) + Len(StrIni) Entre_Texto = Mid$(StrIn, IniPos, Pos(1) - IniPos) End If End If End Function
Aqui dejo tres funciones que hacen esactamente lo mismo (Ojo esta igual viene incluida pero corregida por un servidor, incluyo la que yo cree y use desde hace mucho). Option Explicit Private Function TextoEntreMedio(Texto As String, Palabra1 As String, Palabra2 As String) TextoEntreMedio = Left$(Mid$(Texto, InStr(Texto, Palabra1) + Len(Palabra1)), InStr(Mid$(Texto, InStr(Texto, Palabra1) + Len(Palabra1)), Palabra2) - 1) End Function Public Function Text_Between_Words(Text As String, String1 As String, String2 As String) As String Dim Pos1 As Integer Dim Pos2 As Integer Dim Start As Integer Dim TotalLen As Integer Pos1 = InStr(Text, String1) Pos2 = InStr(Text, String2) If Pos1 = 0 Or Pos2 = 0 Then GoTo NoExists Start = Pos1 + Len(String1) TotalLen = Pos2 - Start Text_Between_Words = Mid(Text, Start, TotalLen) Exit Function NoExists: MsgBox "Error, check that the two words are in the text, if so," & vbCrLf _ & " make sure you are entered correctly.", vbCritical End Function ' ' //////////////////////////////////////////////////////////////// ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' //////////////////////////////////////////////////////////////// Public Function Entre_Texto(ByRef StrIn As String, ByVal StrIni As String, ByVal StrFin As String, Optional ComparacionEstricta As Boolean) As String Dim Pos(1) As Long Dim IniPos As Long Dim OptionalCompare As VbCompareMethod If Len(StrIn) > 0 Then If ComparacionEstricta Then OptionalCompare = vbBinaryCompare Else OptionalCompare = vbTextCompare End If Pos(0) = InStr(1, StrIn, StrIni, OptionalCompare) Pos(1) = InStr(1, StrIn, StrFin, OptionalCompare) If CBool(Pos(0)) And CBool(Pos(1)) And Pos(0) < Pos(1) Then IniPos = Pos(0) + Len(StrIni) Entre_Texto = Mid$(StrIn, IniPos, Pos(1) - IniPos) End If End If End Function Private Sub Form_Load() Const StrOri As String = "Miguel Angel Ortega Avila" Const StrIni As String = "an" Const StrFin As String = "vila" MsgBox Text_Between_Words(StrOri, StrIni, StrFin) MsgBox TextoEntreMedio(StrOri, StrIni, StrFin) MsgBox Entre_Texto(StrOri, StrIni, StrFin, True) MsgBox Entre_Texto(StrOri, StrIni, StrFin, False) End Sub
Dulce Infierno Lunar!¡.
|
|
|
En línea
|
The Dark Shadow is my passion.
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
se me olvido el formato REAL de InStr() es Function InStr([Start], [String1], [String2], [Compare As VbCompareMethod = vbBinaryCompare]) Miembro de VBA.Strings Devuelve la posición de la primera instancia de una cadena dentro de otra
Function InStrB([Start], [String1], [String2], [Compare As VbCompareMethod = vbBinaryCompare]) Miembro de VBA.Strings Devuelve la posición del byte de la primera instancia de una cadena dentro de otra
Function InStrRev(StringCheck As String, StringMatch As String, [Start As Long = -1], [Compare As VbCompareMethod = vbBinaryCompare]) As Long Miembro de VBA.Strings Returns the position of the last occurrence of one string within another
Para quien no sepa que funciones existen en vb6 abran el IDE creen o abaran un nuevo proyecto y opriman la fecla [/b]F2
Tamabien se pueden acceder desde el Intelicense escribiendo
VBA.
como si fuese
Me.
Text1.
ETC...
Dulce Infierno Lunar!¡.
|
|
« Última modificación: 31 Mayo 2010, 23:48 pm por BlackZeroX▓▓▒▒░░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
|
|