Acquista i nostri libri consigliati su Amazon.it
+ Rispondi al messaggio
Pagina 1 di 2 12 ultimoultimo
Visualizzazione dei risultati da 1 a 10 su 20

Cercare celle contenenti una stringa ma che non contengono un'altra stringa

  1. #1
    genespos non è in linea Scribacchino
    Ciao a tutti.

    Dovrei cercare le celle che contengono una stringa (e fin qui tutto normale basta usare Cells.Find) ma ho il problema che la stringa che cerco si può trovare in celle che non mi interessano.

    Faccio un esempio:
    devo cercare la cella contenente la stringa "libro di Marco"
    nel foglio ci sono le seguenti celle
    "libro di Marco giallo" (mi interessa)
    "libro di Marco rosso" (mi interessa)
    "libro di Marco a casa di Mario" (non mi interessa)
    "Penna di Mario sul libro di Marco" (non mi interessa)
    "libro di Marco a casa di Giorgio" (non mi interessa)

    Tutto quello che ho per distinguere le celle che non mi interessano sono una serie di stringhe che possono individuare le caselle da escludere.

    Nell'esempio sopra dovrei escludere dalla ricerca le celle contenenti la stringa "Penna" e la stringa "a casa di".

    Ho cercato un po' in giro ma non ho trovato nulla.
    Sembra strano che nessuno abbia mai avuto questa necessità dato che l'operatore "NOT" è presente in tutte le maschere di ricerca (quindi si suppone sia utile a molti).

    Chiedevo se (come spero) esiste l'opzione da inserire nel comando Cells.Find

    Se non esiste l'unica alternativa che ho pensato è quella di creare una matrice con tutte le stringhe che individuano celle da escludere e un'altra matrice da riempire con le coordinate delle celle contenenti il testo da escludere.

    Quindi, dopo aver fatto un ciclo di ricerca per tutti i testi da escludere ed aver memorizzato tutte le coordinate delle celle da escludere fare la ricerca del testo verificando (ad ogni occorrenza che le coordinate della cella siano diverse da quelle memorizzate nella seconda matrice.

    Non c'è bisogno di spiegare perché spero di trovare aiuto e una soluzione alternativa meno arzigogolata.

    CONFIDO NEL VOSTRO AIUTO

    GRAZIE

  2. #2
    L'avatar di Zer0Kelvin
    Zer0Kelvin non è in linea Scolaretto
    Salve.
    Penso che la soluzione sia piuttosto banale: dopo aver trovato la cella contenente la stringa da cercare, puoi controllare (ad es. con la funzione InStr) che la stessa contenga o meno la stringa di esclusione ed utilizzare una condizione If...Then per escludere il risultato indesiderato...
    ℹ️ Leggi di più su Zer0Kelvin ...

  3. #3
    ricky53 non è in linea Scribacchino
    Ciao,
    leggi il suggerimento di 0°K.

    Si penso anch'io che con un opportuno "If" magari con più di un "And" ...

    Puoi inviare il codice sul quale stai lavorando?
    ℹ️ Leggi di più su ricky53 ...

  4. #4
    genespos non è in linea Scribacchino
    In effetti sembra una soluzione percorribile.

    Il codice, non avendo ancora deciso come farlo, non ho ancora iniziato a scriverlo.

    Ora butto giù qualcosa e poi mi rifaccio vivo.

    Comunque è opportuno qualche altro chiarimento su quello che devo fare:

    Innanzi tutto voglio chiarire che devo "ristrutturare" un foglio nel senso che adesso ho le indicazioni ordinate per colonna e voglio ordinarle per riga e, contemporaneamente, voglio eliminare tutto quello che non serve (quindi recupero solo quello che è utile).

    Detto questo
    1) le celle contenti le stringhe "da escludere" non sono inutili ma devono solo essere copiate in un'altra destinazione;

    2) per ogni colonna ho circa 20 celle da recuperare (purtroppo il numero non è costante);

    3) il problema del testo da escludere si pone per più di una stringa da cercare (quindi va ripetuto tutto il ciclo di ricerca ed esclusione più volte per ogni colonna).

    A presto.

  5. #5
    ricky53 non è in linea Scribacchino
    Ciao,
    riorganizza ma con molta attenzione i dati e fatti risentire ...scriveremo del codice VBA opportuno e ... ne usciremo !!!
    ℹ️ Leggi di più su ricky53 ...

  6. #6
    genespos non è in linea Scribacchino
    Rieccomi

    Con molte difficoltà sono riuscito a scrivere un codice che ho potuto provare solo in parte.

    Infatti quando la matrice "TestoErrore" (che può assumere un numero diverso di valori) ha un solo valore, l'istuzione Erase mi dà errore (evidentemente non la considera matrice).

    Si dovrebbe forzare la qualificazione come matrice anche per un solo valore (ma come si fa?).

    Ho cercato in giro ma non ho trovato nulla.
    Qualche idea?

    Questo è il codice che ho scritto:

    Sub Trova_e_Escludi_Errori()
    Set AppSh = ActiveWorkbook.Worksheets("Appunti")
    StringaBase = AppSh.Range("A1:A23")
    ErrNumECol = AppSh.Range("B1:C23")
    Dim TestoErrore As Variant
    '
    For CicloFoglio = 1 To Sheets.Count - 2
        Sheets(CicloFoglio).Activate
        UC = ActiveCell.SpecialCells(xlLastCell).Column
            For CicloColonna = 1 To UC
            Cells(1, CicloColonna).Activate
            Lett1 = InStr(2, ActiveCell.Address, "$", vbTextCompare)
            Lett2 = Left(ActiveCell.Address, Lett1)
            LetteraCol = Replace(Lett2, "$", "")
            UltRiga = Range(LetteraCol & Rows.Count).End(xlUp).Row
            Range(ActiveCell.Address & ":" & LetteraCol & UltRiga).Select
                For CicloCercaBase = 1 To 23
    Cerca:
                        Trovato = Cells.Find(What:=StringaBase(CicloCercaBase, 1), After:=ActiveCell, LookIn:=xlFormulas, _
                        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
                            Select Case ErrNumECol(CicloCercaBase, 1)
                            Case 0
                                GoTo AssegnaValore
                            Case 1
                                TestoErrore = AppSh.Range(ErrNumECol(CicloCercaBase, 2) & "1:" & ErrNumECol(CicloCercaBase, 2) & ErrNumECol(CicloCercaBase, 1))
    '                            TestoErrore = AppSh.Cells(CicloErrori, CicloCercaBase + 2).Value
                                If InStr(1, Trovato, TestoErrore, vbTextCompare) = 0 Then
                                GoTo AssegnaValore
                                Else: GoTo Cerca
                                End If
                            Case 2
                                TestoErrore = AppSh.Range(ErrNumECol(CicloCercaBase, 2) & "1:" & ErrNumECol(CicloCercaBase, 2) & ErrNumECol(CicloCercaBase, 1))
                                If InStr(1, Trovato, TestoErrore(1, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(2, 1), vbTextCompare) = 0 Then
                                GoTo AssegnaValore
                                Else: GoTo Cerca
                                End If
                            Case 3
                                TestoErrore = AppSh.Range(ErrNumECol(CicloCercaBase, 2) & "1:" & ErrNumECol(CicloCercaBase, 2) & ErrNumECol(CicloCercaBase, 1))
                                If InStr(1, Trovato, TestoErrore(1, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(2, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(3, 1), vbTextCompare) = 0 Then
                                GoTo AssegnaValore
                                Else: GoTo Cerca
                                End If
                            Case 4
                                TestoErrore = AppSh.Range(ErrNumECol(CicloCercaBase, 2) & "1:" & ErrNumECol(CicloCercaBase, 2) & ErrNumECol(CicloCercaBase, 1))
                                If InStr(1, Trovato, TestoErrore(1, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(2, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(3, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(4, 1), vbTextCompare) = 0 Then
                                GoTo AssegnaValore
                                Else: GoTo Cerca
                                End If
                            End Select
    AssegnaValore:
    'Istruzioni da immettere
    CercaAltro:
                        Erase TestoErrore
                Next CicloCercaBase
            Next CicloColonna
    Next CicloFoglio
    End Sub
    
    Mi correggo, ho aggiunto le () al Dim e sembra che il problema dell'Erase si sia risolto ma adesso mi da un errore "Tipo non corrispondente" sull'istruzione:
    TestoErrore = AppSh.Range(ErrNumECol(CicloCercaBase, 2) & "1:" & ErrNumECol(CicloCercaBase, 2) & ErrNumECol(CicloCercaBase, 1))
    
    Eppure ho controllato il valore delle variabili e dovrebbe essere
    TestoErrore = AppSh.Range("D1:D3")
    
    Ho anche provato a correggere la riga scrivendo i valori della variabile e mettendo per esteso il foglio di lavoro ed ho anche provato ad assegnare valore String alla matrice ma il risultato non è cambiato.

    Non riesco proprio a capire cos'è che non va!

    Ci sono novità:

    ho trovato una soluzione poco ortodossa ma efficace:
    ho portato a 2 il numero minimo di stringhe errore (inserendo in aggiunta un testo senza significato) e ho fatto anche qualche altra correzione ora la macro sembra funzionare ma non lo saprò fino a che non avrò completato "Assegna Valore" ed avrò visto cosa succede.

    Comunque, se avete suggerimenti per una soluzione tecnicamente più valida sono pronto ad ascoltarli e ad imparare.

    Questa è la macro attuale:
    Sub Trova_e_Escludi_Errori()
    Set AppSh = ActiveWorkbook.Worksheets("Appunti")
    StringaBase = AppSh.Range("A1:A23")
    ErrNumECol = AppSh.Range("B1:C23")
    Dim TestoErrore As Variant
    '
    For CicloFoglio = 1 To Sheets.Count - 2
        Sheets(CicloFoglio).Activate
        UC = ActiveCell.SpecialCells(xlLastCell).Column
            For CicloColonna = 1 To UC
            Cells(1, CicloColonna).Activate
            Lett1 = InStr(2, ActiveCell.Address, "$", vbTextCompare)
            Lett2 = Left(ActiveCell.Address, Lett1)
            LetteraCol = Replace(Lett2, "$", "")
            UltRiga = Range(LetteraCol & Rows.Count).End(xlUp).Row
            Range(ActiveCell.Address & ":" & LetteraCol & UltRiga).Select
                For CicloCercaBase = 1 To 23
    Cerca:
                        Trovato = Cells.Find(What:=StringaBase(CicloCercaBase, 1), After:=ActiveCell, LookIn:=xlFormulas, _
                        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
    Casi:
                        Select Case ErrNumECol(CicloCercaBase, 1)
                            Case 0
                                GoTo AssegnaValore
                            Case 1
                                TestoErrore = AppSh.Range(ErrNumECol(CicloCercaBase, 2) & "1:" & ErrNumECol(CicloCercaBase, 2) & ErrNumECol(CicloCercaBase, 1))
    '                            TestoErrore = AppSh.Cells(CicloErrori, CicloCercaBase + 2).Value
                                If InStr(1, Trovato, TestoErrore, vbTextCompare) = 0 Then
                                GoTo AssegnaValore
                                Else:
                                Selection.FindNext(After:=ActiveCell).Activate
                                Trovato = ActiveCell.Value
                                GoTo Casi
                                End If
                            Case 2
                                TestoErrore = AppSh.Range(ErrNumECol(CicloCercaBase, 2) & "1:" & ErrNumECol(CicloCercaBase, 2) & ErrNumECol(CicloCercaBase, 1))
                                If InStr(1, Trovato, TestoErrore(1, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(2, 1), vbTextCompare) = 0 Then
                                GoTo AssegnaValore
                                Else:
                                Selection.FindNext(After:=ActiveCell).Activate
                                Trovato = ActiveCell.Value
                                GoTo Casi
                                End If
                            Case 3
                                TestoErrore = AppSh.Range(ErrNumECol(CicloCercaBase, 2) & "1:" & ErrNumECol(CicloCercaBase, 2) & ErrNumECol(CicloCercaBase, 1))
                                If InStr(1, Trovato, TestoErrore(1, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(2, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(3, 1), vbTextCompare) = 0 Then
                                GoTo AssegnaValore
                                Else:
                                Selection.FindNext(After:=ActiveCell).Activate
                                Trovato = ActiveCell.Value
                                GoTo Casi
                                End If
                            Case 4
                                TestoErrore = AppSh.Range(ErrNumECol(CicloCercaBase, 2) & "1:" & ErrNumECol(CicloCercaBase, 2) & ErrNumECol(CicloCercaBase, 1))
                                If InStr(1, Trovato, TestoErrore(1, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(2, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(3, 1), vbTextCompare) = 0 _
                                And InStr(1, Trovato, TestoErrore(4, 1), vbTextCompare) = 0 Then
                                GoTo AssegnaValore
                                Else:
                                Selection.FindNext(After:=ActiveCell).Activate
                                Trovato = ActiveCell.Value
                                GoTo Casi
                                End If
                            End Select
    AssegnaValore:
    'Istruzioni da immettere
    CercaAltro:
                        Erase TestoErrore
                Next CicloCercaBase
            Next CicloColonna
    Next CicloFoglio
    End Sub
    
    Ultima modifica di genespos; 10-07-2013 13:51  Motivo: Prove successive

  7. #7
    Chico non è in linea Scolaretto
    Ti riporto una nota tratta dalla Guida di Excel:
    "Per assegnare una matrice ad un'altra matrice, verificare che la matrice indicata nel lato sinistro dell'assegnazione sia ridimensionabile e che i tipi della matrice corrispondano."
    Quindi prima dell'assegnazione devi ridimensionare TestoErrore. Questo codice funziona:
    Sub Chico()
    Dim testoerrore() As Variant
    Dim MyRange As Range
        Set AppSh = ActiveWorkbook.Worksheets("Appunti")
        Set MyRange = AppSh.Range("A1:A23")
        ReDim testoerrore(MyRange.Rows.Count, MyRange.Columns.Count)
        testoerrore = MyRange
    End Sub
    
    La cosa che non mi spiego nemmeno io è che se ridimensioni in modo "casuale" testoerrore nel seguente modo:
      ReDim testoerrore(1)
    
    ...il codice funziona lo stesso.

  8. #8
    genespos non è in linea Scribacchino
    Grazie per la risposta ma, mentre tu postavi l'ho fatto anch'io, (magari vai a dare un'occhiata).

    Comunque il problema si verifica quando il Range è di una sola cella perché, in quel caso, mi rifiuta di eseguire Erase perché non riconosce la variabile come matrice ma come una comune variabile stringa.

    Come dicevo sopra ho risolto portando (con un fake) a 2 il numero minimo di valori della matrice ma credo ci debba essere una soluzione tecnica a questo problema e vorrei conoscerla, anche solo per imparare qualcosa di nuovo.

    Ciao

    P.S. Mi domandavo se poteva essere consigliabile un Gosub Return per eseguire
    [CODE]
    Selection.FindNext(After:=ActiveCell).Activate
    Trovato = ActiveCell.Value
    GoTo Casi
    [/CODEE]

    Ri-ciao

  9. #9
    Chico non è in linea Scolaretto
    Capito. Allora forse il problema è nelle "conversioni automatiche" dei tipi di dati in VBA ed è risolvibile "costringendo" VBA a trasformare anche una singola cella in un Array.
    Questo a me funzione.

    Sub Chico()
    Dim testoerrore() As Variant
    Dim MyRange As Range
        Set AppSh = ActiveWorkbook.Worksheets("Appunti")
        Set MyRange = AppSh.Range("A1:A1")
        testoerrore = Array(MyRange)
        Erase testoerrore
    End Sub
    

  10. #10
    genespos non è in linea Scribacchino
    Purtroppo non funziona!

    Invece di attribuire i valori del range nella finestra delle variabili (ampliando la voce TestoErrore) compare un elenco lunghissimo di scritte (la maggior parte per me incomprensibili), tra le quali (sotto la voce local o giù di lì) ci sono anche i valori del range.

    Però nel codice non recupera i valori e, quando richiamo la variabile (per esempio Testoerrore(2, 1)) mi dà errore: "non incluso nell'intervallo".

    Scusa che ne pensi del Gosub?
    Potrei usarlo o è meglio lasciare le righe ripetute in ogni "caso"?

    Ciao (e grazie)

+ Rispondi al messaggio
Pagina 1 di 2 12 ultimoultimo

Potrebbero interessarti anche ...

  1. Cercare una stringa
    Da CC88 nel forum Microsoft SQL Server
    Risposte: 6
    Ultimo Post: 13-07-2017, 16:37
  2. Ricerca da VBA di una stringa all'interno di un'altra stringa
    Da giovepan nel forum Microsoft Access
    Risposte: 2
    Ultimo Post: 25-01-2017, 09:17
  3. inserire una stringa all'interno di un'altra stringa
    Da giuseppe morris nel forum Python
    Risposte: 2
    Ultimo Post: 11-08-2015, 20:35
  4. cercare stringa co vba
    Da antonello74 nel forum Microsoft Word
    Risposte: 3
    Ultimo Post: 01-01-2009, 15:10
  5. cercare una stringa in tutti i file
    Da theiden nel forum Visual Basic .Net
    Risposte: 0
    Ultimo Post: 25-05-2007, 17:04