Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

[Excel] estrarre stringa specifica

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

[Excel] estrarre stringa specifica

Postdi mirmidone21 » 20/11/15 16:08

buonasera a tutti
vado subito al problema.
ho una colonna con una serie di stringhe alfanumeriche, e io devo estrarre da queste solo quelle che all'interno hanno una particolare sequenza.
abbiano cioè all'interno i caratteri Y1 - YC1 - YM1
avrei anche risolto sia con la funzione stringa-estrai sia con l'impostazione di un filtro avanzato di questo tipo
Codice: Seleziona tutto
colonna1    colonna1   colonna1   colonna1   colonna1   colonna1   colonna1   colonna1
*Y15*        <>*YY*      <>*DY*   <>*CY*     <>*EY*     <>*AY*     <>*RY*     <>*OY*
*YC1*                     
*YM1*

ma vorrei sapere se c'è un metodo migliore, al limite anche con qualche macro.
tenete presente che il file contiene + di 700.000 righe
grazie
vi allego il file di esempio
http://www.fileconvoy.com/dfl.php?id=g02f276ebe83f4f79999750866456682ba84e96123
Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Sponsor
 

Re: estrarre stringa specifica

Postdi Anthony47 » 21/11/15 10:35

Ma le stringhe Y1 - YC1 - YM1 devono essere tutte presenti nel testo della cella, o ne basta una sola? E quelle tre sono le uniche condizioni o ce ne sono altre, come farebbe pensare il set di filtri avanzati?
Comunque, se per "metodo migliore" intendi "metodo piu' veloce" serve almeno un file con 10mila record per confrontare i tempi di esecuzione e scegliere l'approccio piu' efficace.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: estrarre stringa specifica

Postdi mirmidone21 » 22/11/15 10:10

ciao, e grazie per la risposta.
allora in ogni stringa, basta che sia presente una delle condizioni (Y1 - YC1 - YM1) cioè, basta che sia presente in ogni stringa una delle accoppiate di caratteri, anche perchè non ci saranno mai tutti e tre insieme nella stessa stringa.
ma devono essere escluse le altre che vedi in orizzontale, cioè YY - DY - CY - EY - AY - RY - OY
per quanto riguarda il set di filtri avanzati, mi sembra di aver capito che quando si mettono le condizioni in verticale significa and, e in orizzontale or - è giusto o sbaglio?
domani che vad in ufficio carico una lista di 10.000
Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Re: estrarre stringa specifica

Postdi Anthony47 » 23/11/15 02:33

Quindi deve essere presente almeno UNA tra le prime 3 stringhe (Y1 - YC1 - YM1) e NESSUNA tra successive 7 stringhe (YY - DY - CY - EY - AY - RY - OY).
Attendo un file di test, con l'indicazione del tempo necessario per processarlo tramite il filtro avanzato (serve come "scala" tra i tuoi tempi e quelli che otterro' io).

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: estrarre stringa specifica

Postdi mirmidone21 » 23/11/15 09:33

esattamente così, i tempi in genere sono di circa 6-7 min.
ecco il file
http://www.fileconvoy.com/dfl.php?id=g5 ... 592d0c2bd2
Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Re: estrarre stringa specifica

Postdi scossa » 23/11/15 10:03

mirmidone21 ha scritto:esattamente così, i tempi in genere sono di circa 6-7 min.
ecco il file
http://www.fileconvoy.com/dfl.php?id=g5 ... 592d0c2bd2


Purtroppo il mio antivirus blocca il sito fileconvoy, potresti cortesemente usare un altro host (p.e. dropbox o google drive)?
Bye!
scossa

Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
Avatar utente
scossa
Utente Senior
 
Post: 424
Iscritto il: 01/04/12 16:40
Località: Provincia di Verona

Re: estrarre stringa specifica

Postdi mirmidone21 » 23/11/15 10:56

Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Re: estrarre stringa specifica

Postdi Anthony47 » 23/11/15 15:16

Prova con questa macro:
Codice: Seleziona tutto
Sub filtra()
Dim OutSh As String, StrSh As String, YesStr, NoStr, LastA As Long, J As Long, myTim As Double
Dim I As Long, cFound As Long, CRowV As String, YesOk As Boolean, NoNOk As Boolean
Dim NextOut As Long
'
OutSh = "FoglioZ"           '<<< Il foglio dove si crea l'elenco filtrato
YesStr = Array("Y1", "YC1", "YM1")
NoStr = Array("YY", "DY", "CY", "EY", "AY", "RY", "OY")
LastA = Cells(Rows.Count, 1).End(xlUp).Row
myTim = Timer
Sheets(OutSh).Range("A:A").ClearContents
For I = 2 To LastA
    YesOk = False: NoNOk = False
    CRowV = Cells(I, 1).Value
    For J = LBound(YesStr, 1) To UBound(YesStr, 1)
        cFound = InStr(1, CRowV, YesStr(J), vbTextCompare)
        If cFound > 0 Then YesOk = True: Exit For
    Next J
    For J = LBound(NoStr, 1) To UBound(NoStr, 1)
        cFound = InStr(1, CRowV, NoStr(J), vbTextCompare)
        If cFound > 0 Then NoNOk = True: Exit For
    Next J
    If YesOk And Not NoNOk Then
        NextOut = NextOut + 1
        Sheets(OutSh).Cells(NextOut, 1) = Cells(I, 1)
    End If
Next I
MsgBox ("Completato, Sec. " & Format(Timer - myTim, "0.00"))
End Sub


La riga marcata <<< deve essere personalizzata col nome del foglio su cui sara' creato l'elenco filtrato; il foglio deve gia' esistere e la Colonna A SARA' AZZERATA SENZA PREAVVISO all'avvio della macro

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: estrarre stringa specifica

Postdi mirmidone21 » 23/11/15 16:10

funge alla perfezione in 0.13 sec
meraviglioso
non so come hai fatto, mi piacerebbe capirlo, ma non sono pratico di VB.
grazie infinite
Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Re: estrarre stringa specifica

Postdi scossa » 23/11/15 19:20

mirmidone21 ha scritto:eccolo su google drive
https://drive.google.com/open?id=0B2rmV ... GJsRlJIVzg


Il file non è pubblico, quindi non me lo fa scaricare, sorry.
Bye!
scossa

Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
Avatar utente
scossa
Utente Senior
 
Post: 424
Iscritto il: 01/04/12 16:40
Località: Provincia di Verona

Re: estrarre stringa specifica

Postdi mirmidone21 » 23/11/15 19:45

scossa ha scritto:
mirmidone21 ha scritto:eccolo su google drive
https://drive.google.com/open?id=0B2rmV ... GJsRlJIVzg


Il file non è pubblico, quindi non me lo fa scaricare, sorry.

questo dovrebbe andare bene, scusami
https://drive.google.com/file/d/0B2rmVF ... sp=sharing
Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Re: estrarre stringa specifica

Postdi mirmidone21 » 23/11/15 19:50

Anthony47 ha scritto:Prova con questa macro:
Codice: Seleziona tutto
Sub filtra()
Dim OutSh As String, StrSh As String, YesStr, NoStr, LastA As Long, J As Long, myTim As Double
Dim I As Long, cFound As Long, CRowV As String, YesOk As Boolean, NoNOk As Boolean
Dim NextOut As Long
'
OutSh = "FoglioZ"           '<<< Il foglio dove si crea l'elenco filtrato
YesStr = Array("Y1", "YC1", "YM1")
NoStr = Array("YY", "DY", "CY", "EY", "AY", "RY", "OY")
LastA = Cells(Rows.Count, 1).End(xlUp).Row
myTim = Timer
Sheets(OutSh).Range("A:A").ClearContents
For I = 2 To LastA
    YesOk = False: NoNOk = False
    CRowV = Cells(I, 1).Value
    For J = LBound(YesStr, 1) To UBound(YesStr, 1)
        cFound = InStr(1, CRowV, YesStr(J), vbTextCompare)
        If cFound > 0 Then YesOk = True: Exit For
    Next J
    For J = LBound(NoStr, 1) To UBound(NoStr, 1)
        cFound = InStr(1, CRowV, NoStr(J), vbTextCompare)
        If cFound > 0 Then NoNOk = True: Exit For
    Next J
    If YesOk And Not NoNOk Then
        NextOut = NextOut + 1
        Sheets(OutSh).Cells(NextOut, 1) = Cells(I, 1)
    End If
Next I
MsgBox ("Completato, Sec. " & Format(Timer - myTim, "0.00"))
End Sub


La riga marcata <<< deve essere personalizzata col nome del foglio su cui sara' creato l'elenco filtrato; il foglio deve gia' esistere e la Colonna A SARA' AZZERATA SENZA PREAVVISO all'avvio della macro

Ciao

solo una cosa, se cambio la posizione della colonna, tipo in C, devo cambiare qualcosa?
il riferimento a J a cosa serve?
Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Re: estrarre stringa specifica

Postdi scossa » 23/11/15 20:03

Anthony47 ha scritto:Prova con questa macro:


Purtroppo non posso scaricare il file, ma propongo una modifica al codice di Anthony: verificare prima l'assenza delle sigle "negative" e solo se assenti verificare la presenza delle "positive":

Codice: Seleziona tutto
Sub filtra2()
  Dim OutSh As String, YesStr, NoStr, LastA As Long, j As Long, myTim As Single
  Dim I As Long, cFound As Long, CRowV As String
  Dim NextOut As Long

OutSh = "Foglio2"           '<<< Il foglio dove si crea l'elenco filtrato
YesStr = Array("Y1", "YC1", "YM1")
NoStr = Array("YY", "DY", "CY", "EY", "AY", "RY", "OY")
LastA = Cells(Rows.Count, 1).End(xlUp).Row
myTim = Timer
Sheets(OutSh).Range("A:A").ClearContents
For I = 1 To LastA
    CRowV = Cells(I, 1).Value
    For j = LBound(NoStr, 1) To UBound(NoStr, 1)
        cFound = InStr(1, CRowV, NoStr(j), vbTextCompare)
        If cFound > 0 Then Exit For
    Next j
    If cFound = 0 Then
      For j = LBound(YesStr, 1) To UBound(YesStr, 1)
          cFound = InStr(1, CRowV, YesStr(j), vbTextCompare)
          If cFound > 0 Then
            NextOut = NextOut + 1
            Sheets(OutSh).Cells(NextOut, 1) = Cells(I, 1)
            Exit For
          End If
      Next j
    End If
Next I
MsgBox ("Completato, Sec. " & Format(Timer - myTim, "0.00"))
End Sub
Bye!
scossa

Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
Avatar utente
scossa
Utente Senior
 
Post: 424
Iscritto il: 01/04/12 16:40
Località: Provincia di Verona

Re: estrarre stringa specifica

Postdi Anthony47 » 23/11/15 23:40

Ciao scossa, le tue osservazioni hanno sempre un fondamento...
In effetti non ha senso fare ambedue i controlli se gia' il primo risultasse negativo, quindi ho adottato la tua filtra2.
Con stupore ho visto che il tempo tra filtra e filtra2 si riduce di pochi centesimi di secondo, misurato su un totale di 5 prove per un totale di oltre 100 secondi.
Anche elaborando in modo diverso la ricerca (tipo invertire i controlli e skippare se esito negativo) le differenze rimangono dell'ordine max di 2 decimi su circa 104 secondi, cioe' dell'ordine dello 0,2%.
Questo dimostra, ma lo dovevamo sapere, che i tempi maggiori sono consumati per scrivere sul secondo foglio...
Ho quindi elaborato una filtra33 che usa un array da 10mila posizioni per accumulare la colonna filtrata, con successivo dump dei risultati sul foglio target all'esaurimento dello spazio.
In questo modo, i cicli che prima duravano circa 20 sec ora si completano in 0,3 Sec.

Il codice corrispondente, che sostituisce interamente la Sub filtra:
Codice: Seleziona tutto
Sub filtra33()
Dim OutSh As String, StrSh As String, YesStr, NoStr, LastA As Long, j As Long, myTim As Double
Dim I As Long, cFound As Long, CRowV As String, YesOk As Boolean, NoNOk As Boolean
Dim NextOut As Long, OuArr(1 To 10000) As String
'
OutSh = "FoglioZ"           '<<< Il foglio dove si crea l'elenco filtrato
YesStr = Array("Y1", "YC1", "YM1")
NoStr = Array("YY", "DY", "CY", "EY", "AY", "RY", "OY")
LastA = Cells(Rows.Count, 1).End(xlUp).Row
myTim = Timer
Sheets(OutSh).Range("A:A").ClearContents
For I = 2 To LastA
    YesOk = False: NoNOk = False
    CRowV = Cells(I, 1).Value
    For j = LBound(YesStr, 1) To UBound(YesStr, 1)
        cFound = InStr(1, CRowV, YesStr(j), vbTextCompare)
        If cFound > 0 Then YesOk = True: Exit For
    Next j
    If YesOk Then
        For j = LBound(NoStr, 1) To UBound(NoStr, 1)
            cFound = InStr(1, CRowV, NoStr(j), vbTextCompare)
            If cFound > 0 Then NoNOk = True: Exit For
        Next j
        If YesOk And Not NoNOk Then
            NextOut = NextOut + 1
            OuArr(NextOut) = Cells(I, 1)
            If NextOut >= 10000 Then
                Sheets(OutSh).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(NextOut, 1).Value = OuArr
                NextOut = 0
            End If
        End If
    End If
Next I
If NextOut > 0 Then
    Sheets(OutSh).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(NextOut, 1).Value = OuArr
    NextOut = 0
End If
MsgBox ("Completato, Sec. " & Format(Timer - myTim, "0.00"))
End Sub

Le N macro, compresa la filtra33, sono contenute nel file che ho salvato qui: https://www.dropbox.com/s/725y8geigs2d2 ... .xlsm?dl=0

Ps: non ho capito che macchina ha mirmidone per completare il lavoro di 19mila righe in 0.13 secondi; wow...

Ciao a tutti.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: estrarre stringa specifica

Postdi Anthony47 » 24/11/15 00:11

mirmidone ha scritto:solo una cosa, se cambio la posizione della colonna, tipo in C, devo cambiare qualcosa?

Da "Linee guida per pubblicare le vostre domande" (viewtopic.php?f=26&t=103911&p=605595#p605595)
5) Evitate di pubblicare strutture dati diverse da quelle che in realta' dovete gestire, a meno che non siete certi di riuscire ad adattare autonomamente le risposte che vi verranno fornite.


Se i dati di partenza sono contenuti in colonna C allora dovrai cambiare queste due righe:
Non LastA = Cells(Rows.Count, 1).End(xlUp).Row ma LastA = Cells(Rows.Count, "C").End(xlUp).Row
Non CRowV = Cells(I, 1).Value ma CRowV = Cells(I, "C").Value

Queste modifiche non cambiano pero' la colonna di output, che sara' sempre in colonna A del foglio dichiarato come OutSh.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: estrarre stringa specifica

Postdi scossa » 24/11/15 08:53

Ciao,

Anthony47 ha scritto:Con stupore ho visto che il tempo tra filtra e filtra2 si riduce di pochi centesimi di secondo, misurato su un totale di 5 prove per un totale di oltre 100 secondi.


Sì, avevo notato anch'io la stessa differenza (tra i 2 e i 4 centesimi).

La macchina di mirmidone sarà un 486 sovralimentato a nitrometano! :lol:
Bye!
scossa

Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)
Avatar utente
scossa
Utente Senior
 
Post: 424
Iscritto il: 01/04/12 16:40
Località: Provincia di Verona

Re: estrarre stringa specifica

Postdi mirmidone21 » 24/11/15 09:04

Anthony47 ha scritto:Da "Linee guida per pubblicare le vostre domande" (viewtopic.php?f=26&t=103911&p=605595#p605595)
5) Evitate di pubblicare strutture dati diverse da quelle che in realta' dovete gestire, a meno che non siete certi di riuscire ad adattare autonomamente le risposte che vi verranno fornite.


ti ringrazio ed ho capito il richiamo, ed hai/avete ragione, non ho pubblicato tutto il file con le giuste impostazioni delle colonne, perchè è un file di molte colonne, e non volevo creare complicazioni.
per il prosieguo creerò sempre una struttura analoga all'originale.
grazie
Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Re: estrarre stringa specifica

Postdi mirmidone21 » 24/11/15 10:26

Anthony47 ha scritto:Se i dati di partenza sono contenuti in colonna C allora dovrai cambiare queste due righe:
Non LastA = Cells(Rows.Count, 1).End(xlUp).Row ma LastA = Cells(Rows.Count, "C").End(xlUp).Row
Non CRowV = Cells(I, 1).Value ma CRowV = Cells(I, "C").Value

Queste modifiche non cambiano pero' la colonna di output, che sara' sempre in colonna A del foglio dichiarato come OutSh.

Ciao


ho fatto questa modifica
LastA = Cells(Rows.Count, "C").End(xlUp).Row
CRowV = Cells(I, "C").Value

ma quando lancio la macro non mi estrae più i dati, ma mi copia tutta la colonna A
ti allego il file
https://drive.google.com/file/d/0B2rmVF ... sp=sharing
Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Re: estrarre stringa specifica

Postdi mirmidone21 » 24/11/15 11:40

mirmidone21 ha scritto:
Anthony47 ha scritto:Se i dati di partenza sono contenuti in colonna C allora dovrai cambiare queste due righe:
Non LastA = Cells(Rows.Count, 1).End(xlUp).Row ma LastA = Cells(Rows.Count, "C").End(xlUp).Row
Non CRowV = Cells(I, 1).Value ma CRowV = Cells(I, "C").Value

Queste modifiche non cambiano pero' la colonna di output, che sara' sempre in colonna A del foglio dichiarato come OutSh.

Ciao


ho fatto questa modifica
LastA = Cells(Rows.Count, "C").End(xlUp).Row
CRowV = Cells(I, "C").Value

ma quando lancio la macro non mi estrae più i dati, ma mi copia tutta la colonna A
ti allego il file
https://drive.google.com/file/d/0B2rmVF ... sp=sharing


ti aggiungo il link pubblico con anche il foglioz con i risultati
https://drive.google.com/file/d/0B2rmVF ... sp=sharing
Windows 7 sp1 -- Office 2013
Intel i5 4430 -- 3.00 ghz ---- 4gb RAM
mirmidone21
Utente Senior
 
Post: 124
Iscritto il: 26/10/15 16:48

Re:[Excel] estrarre stringa specifica

Postdi Anthony47 » 24/11/15 14:17

In effetti la riga copiata continuava a essere quella di colonna A.
Ho modificato tutta la sub filtra33; in testa ho aggiunto le istruzioni per definire Foglio e Colonna sorgente e Foglio e colonna di output.
Il file pubblicato su Dropbox ieri e' aggiornato con questa modifica; il codice comunque e':
Codice: Seleziona tutto
Sub filtra33()
Dim OutSh As String, StrSh As String, YesStr, NoStr, LastA As Long, j As Long, myTim As Double
Dim I As Long, cFound As Long, CRowV As String, YesOk As Boolean, NoNOk As Boolean
Dim NextOut As Long, OuArr(1 To 10000) As String, StrCol As String, OutCol As String
'
StrSh = "Foglio1"           '<<< Il foglio con l'elenco di partenza
StrCol = "A"                '<<< La colonna dell'elenco di partenza
OutSh = "FoglioZ"           '<<< Il foglio dove si crea l'elenco filtrato
OutCol = "B"                '<<< La colonna dell'elenco filtrato
'
YesStr = Array("Y1", "YC1", "YM1")
NoStr = Array("YY", "DY", "CY", "EY", "AY", "RY", "OY")
LastA = Cells(Rows.Count, StrCol).End(xlUp).Row
myTim = Timer
Sheets(StrSh).Select
Sheets(OutSh).Columns(OutCol).ClearContents
For I = 2 To LastA
    YesOk = False: NoNOk = False
    CRowV = Cells(I, StrCol).Value
    For j = LBound(YesStr, 1) To UBound(YesStr, 1)
        cFound = InStr(1, CRowV, YesStr(j), vbTextCompare)
        If cFound > 0 Then YesOk = True: Exit For
    Next j
    If YesOk Then
        For j = LBound(NoStr, 1) To UBound(NoStr, 1)
            cFound = InStr(1, CRowV, NoStr(j), vbTextCompare)
            If cFound > 0 Then NoNOk = True: Exit For
        Next j
        If YesOk And Not NoNOk Then
            NextOut = NextOut + 1
            OuArr(NextOut) = CRowV
            If NextOut >= 10000 Then
                Sheets(OutSh).Cells(Rows.Count, OutCol).End(xlUp).Offset(1, 0).Resize(NextOut, 1).Value = OuArr
                NextOut = 0
            End If
        End If
    End If
Next I
If NextOut > 0 Then
    Sheets(OutSh).Cells(Rows.Count, OutCol).End(xlUp).Offset(1, 0).Resize(NextOut, 1).Value = OuArr
    NextOut = 0
End If
MsgBox ("Completato in Sec. " & Format(Timer - myTim, "0.00") & vbCrLf & _
    "Processate " & LastA & " linee su foglio " & StrSh & vbCrLf & _
    "Create " & Sheets(OutSh).Cells(Rows.Count, OutCol).End(xlUp).Row & " linee su " & OutSh)
End Sub

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "[Excel] estrarre stringa specifica":


Chi c’è in linea

Visitano il forum: Nessuno e 7 ospiti