Estrazione stringa VBA da posizione

mau1791

unread,

Jan 10, 2012, 1:45:03 PM1/10/12

to

Ciao a tutti,
come posso, tramite vba, ottenere in un Msgbox la restituzione della
stringa preceduta da uno di questi termini:
("DIS", "DIS.", "DISEGNO", "dis", "dis.", "disegno")

ad esempio:

Stelo pistone in acciaio DISEGNO Triax 426 769
--> Triax 426 769

Testata posteriore in acciaio DIS. 1104 229 02
--> 1104 229 02

Galleggiante in 316L DIS TMG 00214
--> TMG 00214

Custodia in acciaio dis. FTV 00255
--> FTV 00255

Flangia in 316L dis FL 114 pos 2
--> FL 114 pos 2

Ghiera posteriore in acciaio disegno 1104 222 02
--> 1104 222 02

Grazie Maurizio

r

unread,

Jan 10, 2012, 4:24:58 PM1/10/12

to

visto che chiedi in VBA, non resisto alla tentazione:

Function Poi(s As String) As String
Dim re
Set re = CreateObject("vbscript.regexp")
re.Pattern = "\b(DIS(?:\.|EGNO)?|dis(?:\.|egno)?)\b(.+$)"
If re.Test(s) Then _
Poi = re.Execute(s)(0).SubMatches.Item(1)
End Function

saluti
r

Scossa

unread,

Jan 10, 2012, 4:36:26 PM1/10/12

to

On 10 Gen, 19:45, mau1791 <maurizio.r...@infinito.it> wrote:

> Ciao a tutti,
> come posso, tramite vba, ottenere in un Msgbox la restituzione della
> stringa preceduta da uno di questi termini:
> ("DIS", "DIS.", "DISEGNO", "dis", "dis.", "disegno")
>
> ad esempio:
>
> Stelo pistone in acciaio DISEGNO Triax 426 769
> --> Triax 426 769

Public Function Disegno(ByVal sTesto As String) As String
Dim nAt As Long
Dim aWhat() As String
Dim sWhat As Variant

aWhat = Split("DIS ;DIS. ;DISEGNO ", ";")

For Each sWhat In aWhat
nAt = InStr(1, sTesto, sWhat, vbTextCompare)
If nAt > 0 Then
Disegno = Mid(sTesto, nAt + Len(sWhat))
End If
Next
End Function

Bye!
scossa

Scossa

unread,

Jan 10, 2012, 4:37:53 PM1/10/12

to

Ciao roby,

C'è qualcosa che non torna:
Testata posteriore in acciaio DIS. 1104 229 02 ---> . 1104 229 02
Custodia in acciaio dis. FTV 00255 ----> . FTV 00255

Bye!
scossa

r

unread,

Jan 10, 2012, 5:11:13 PM1/10/12

to

hai ragione ... una s al posto di una b :

Function Poi(s As String) As String
Dim re
Set re = CreateObject("vbscript.regexp")

re.Pattern = "\b(DIS(?:\.|EGNO)?|dis(?:\.|egno)?)\s(.+$)"

If re.Test(s) Then _
Poi = re.Execute(s)(0).SubMatches.Item(1)
End Function

saluti a 360 watt :-)
r

r

unread,

Jan 10, 2012, 5:19:42 PM1/10/12

to

p.s.
potrei accorciare ma l'OP sembrava convinto nello specificare:

"DIS", "DIS.", "DISEGNO", "dis", "dis.", "disegno"

la mia e la tua svolgono lavori, seppur minimamente, diversi ...
credo però che all'OP possano andare entrambe.
Ri saluti
r

eliano

unread,

Jan 10, 2012, 5:32:44 PM1/10/12

to

On 10 Gen, 23:11, r <robb....@gmail.com> wrote:
>
> hai ragione ... una s al posto di una b :
>

Marianna..... e' un pezzo che ci giravo intorno e non ci sarei mai
arrivato.:-((

r

unread,

Jan 10, 2012, 6:55:18 PM1/10/12

to

beh visto che mi stuzzichi (nel senso buono) questa:

Function Poi(s As String) As String
Dim re
Set re = CreateObject("vbscript.regexp")

re.IGNORECASE = True
re.Pattern = "\b(dis(?:egno)?)\b\.?(.+$)"

If re.Test(s) Then _
Poi = re.Execute(s)(0).SubMatches.Item(1)
End Function

oppure questa:

Function Poi(s As String) As String
Dim re
Set re = CreateObject("vbscript.regexp")

re.Pattern = "\b(DIS(?:EGNO)?|dis(?:egno)?)\b\.?(.+$)"

If re.Test(s) Then _
Poi = re.Execute(s)(0).SubMatches.Item(1)
End Function

sono simili ... leggere differenze ... quasi impercettibili :-)
saluti
r

mau1791

unread,

Jan 11, 2012, 10:55:15 AM1/11/12

to

Grazie tutti, x ottime soluzioni.

Nik

unread,

Jan 14, 2012, 12:44:21 PM1/14/12

to

ciao

lo puoi fare anche senza VBA, usando le funzioni seguenti
=STRINGA.ESTRAI(H13;RICERCA("DISEGNO";H13)+8;1000)
dove H13 contiene per esempio "Stelo pistone in acciaio DISEGNO Triax
426 769"
mentre 8 è la lughezza della parola DISEGNO+1.
Se invece vuoi proprio usare VBA crea una variabile testo e poi fai un
ciclo for per ogni parola da cercare sul range di celle che contiene i
testi che ti interessano elaborandole con le funzioni di gestione
delle stringhe e alimentando la variabile ad ogni ciclo.
Poi fai il msgbox.
ciao
Nik

Nik

unread,

Jan 14, 2012, 1:04:35 PM1/14/12

to

ooops scusa non avevo scaricato tutti i msg ....