ricerca parter di testo in una cella

Question

ciao a tutti,

non riesco ad applicare una formula per verificare se in una cella con del testo c'e' un nome, esempio ho una lista di fatture relative a diversi mesi dell'anno e voglio estrarre solo quelle che hanno un mese in particolare.

Esempio, ho assegnato il nome MESE ad una cella che contiene Marzo,

poi seleziono tutta la colonna della descrizione della fattura, per esempio "prestazioni eseguite nel mese di MARZO nei vostri uffici"

io ho provato con le seguenti formule:

GRAZIE

=CARTELLA.DI.LAVORO.SELEZIONA("FF")
CERCA IL MESE CORRISPONDENTE   NELLA DESCRIZIONE DELLE FATTURE
=SELEZIONA("R1C4:R100C4")
=ERRORE(FALSO)
=SE(FORMULA.TROVA(MESE)=VERO)
=SELEZIONA("R1C1:R1C10")
=AVVISO(" TROVATO   ";3)
=FERMA()
=FINE.SE()
=AVVISO(" NON TROVATO   ";3)
=FERMA()

Answer 1

Ciao Maurizio e buona giornata,

la struttura del mio file è la seguente:

nome file - PR.xls

contiene   le cartelle - RC, RS, BB, FF, TT

più una cartella per le macro excel4.0 - MA

nella cartella RC la cella E3 (R3C5) ho messo il nome casella PrRcE3

(uso questo sistema che mi permette di sapere dove sono ubicate le circa 600 celle che ho rinominato in quanto i primi 2 caratteri sono il nome del file, i secondi due della cartella e i restanti della cella.

Ho visto che il tuo file seleziona anche la prima riga che è quella della descrizione e poi in quelle successive fa la ricerca del mese, per cui ho cambiato il valore

Const cstrSrcRange  As String = "A1"

con

Const cstrSrcRange  As String = "A2"

in questo caso non da più il msx di errore e mi fa la ricerca correttamente interrompendosi quando trova una cella vuota.

A questo punto direi che il tuo aiuto è stato notevole, funziona tutto perfettamente, devo solo integrare con alcune istruzioni in macro 4.0 per:

1. aggiungere all'inizio una riga vuota perché la ricerca inizia dalla seconda, 
2. fargli fare l'ordinamento dati della colonna Descrizione in quanto alcune volte è vuota e si interromperebbe a metà lista,
3. fargli ripetere un'altra volta la routine in quanto la parola mese a volte mia moglie la scrive nella competenza al posto che nella descrizione e in questo caso devo riportare nella destinazione una cella in meno.

cosa che per me con le macro 4.0  è una passeggiata, purtroppo non sono mai riuscito a imparare VBA nonostante abbia passato giornate intere sui manuale che ho scaricato da internet.

 Grazie e alla prossima

Roberto

Answer 2

' --------- PERSONALIZZARE ---------- >

' FF nome della cartella che contiene le fatture e nella cella A1 inizia la ricerca del mese

' RC nome della cartella di destinazione e nella cella X14 dovrebbe copiare 10 celle di

' ogni riga della cartella FF dove trova il nome del mese richiesto

' PrRcE3 è il nome che ho assegnato alla cella che contiene il nome del mese da cercare

' che si trova nel file PR.xls nella cartella RC nella cella E3 

Const cstrSrcName   As String = "FF"

Const cstrDstName   As String = "RC"

Const cstrSrcRange  As String = "X14"

Const clngSrcCols   As Long = 10

Const cstrDstRange  As String = "A1"

Const cstrMatch     As String = "PrRcE3"

'

' --------- PERSONALIZZARE ---------- <     

Ciao Roberto,

se non ci sono sviste in quanto qui su quotato allora le cose dovrebbero essere diverse:

' --------- PERSONALIZZARE ---------- >

' FF nome della cartella che contiene le fatture e nella cella A1 inizia la ricerca del mese

' RC nome della cartella di destinazione e nella cella X14 dovrebbe copiare 10 celle di

' ogni riga della cartella FF dove trova il nome del mese richiesto

' PrRcE3 è il nome che ho assegnato alla cella che contiene il nome del mese da cercare

' che si trova nel file PR.xls nella cartella RC nella cella E3 

Const cstrSrcName   As String = "FF"

Const cstrDstName   As String = "RC"

Const cstrSrcRange  As String = "A1"

Const clngSrcCols   As Long = 10

Const cstrDstRange  As String = "X14"

Const cstrMatch     As String = "PrRcE3"

'

' --------- PERSONALIZZARE ---------- <

(Perché Src sta per Source, Origine; e Dst sta per Destination, Destinazione.)

Qualche dubbio me lo fa venire la tua precisazione riguardo il nome della cella che contiene il nome del mese da cercare:

1. cosa vuol dire che questa si trova nel file PR.xls? I due Fogli di lavoro FF e RC non appartengono alla stessa Cartella di lavoro?
2. Il nome PrRcE3 è un nome di AmbitoCartella di lavoroo del Foglio di lavoro RC?

Answer 3

Ciao Maurizio,

sul tuo file di esempio funziona perfettamente ma nel mio mi da "errore definito dall'applicazione o dall'oggetto"

ho fatto i seguenti cambiamenti:

Option Explicit

Public Sub Test()

On Error GoTo ExtP

' --------- PERSONALIZZARE ---------- >

' FF nome della cartella che contiene le fatture e nella cella A1 inizia la ricerca del mese

' RC nome della cartella di destinazione e nella cella X14 dovrebbe copiare 10 celle di

' ogni riga della cartella FF dove trova il nome del mese richiesto

' PrRcE3 è il nome che ho assegnato alla cella che contiene il nome del mese da cercare

' che si trova nel file PR.xls nella cartella RC nella cella E3 

Const cstrSrcName   As String = "FF"

Const cstrDstName   As String = "RC"

Const cstrSrcRange  As String = "X14"

Const clngSrcCols   As Long = 10

Const cstrDstRange  As String = "A1"

Const cstrMatch     As String = "PrRcE3"

'

' --------- PERSONALIZZARE ---------- <

Dim wbk     As Excel.Workbook

Dim wshSrc As Excel.Worksheet

Dim rngSrc As Excel.Range

Dim wshDst As Excel.Worksheet

Dim rngDst As Excel.Range

Dim strMatch  As String

Dim strValue  As String

Dim lngSrcRow As Long

Dim lngDstRow As Long

    Set wbk = Application.ThisWorkbook

    With wbk

      Set wshSrc = .Worksheets(cstrSrcName)

      Set wshDst = .Worksheets(cstrDstName)

      strMatch = " " & .Names(cstrMatch).RefersToRange.Value & " "

    End With

    Set rngSrc = wshSrc.Range(cstrSrcRange)

    Set rngDst = wshDst.Range(cstrDstRange)

    rngDst.CurrentRegion.ClearContents

    rngSrc.Offset(-1).Copy rngDst.Offset(-1)

    With rngSrc

      Do Until IsEmpty(.Offset(lngSrcRow).Value)

        strValue = " " & .Offset(lngSrcRow).Value & " "

        If InStr(1, strValue, strMatch, vbTextCompare) Then

          .Offset(lngSrcRow).Resize(ColumnSize:=clngSrcCols) _

              .Copy rngDst.Offset(lngDstRow)

          lngDstRow = lngDstRow + 1

        End If

        lngSrcRow = lngSrcRow + 1

      Loop

    End With

ExtP:

    With Err

      If .Number Then MsgBox .Description

    End With

    On Error Resume Next

    Set rngDst = Nothing

    Set wshDst = Nothing

    Set rngSrc = Nothing

    Set wshSrc = Nothing

    Set wbk = Nothing

End Sub

grazie

Roberto

Answer 4

Ciao robybarc,

ipotizzando che le colonne origine siano 4, nel codice qui sotto ho evidenziato in grassetto le modifiche da apportare:

Public Sub Test()

On Error GoTo ExtP

' --------- PERSONALIZZARE ---------- >

'

Const cstrSrcName   As String = "Foglio1"

Const cstrDstName   As String = "Foglio2"

Const cstrSrcRange  As String = "A2"

Const clngSrcCols   As Long = 4

Const cstrDstRange  As String = "C4"

Const cstrMatch     As String = "MESE"

'

' --------- PERSONALIZZARE ---------- <

Dim wbk     As Excel.Workbook

Dim wshSrc As Excel.Worksheet

Dim rngSrc As Excel.Range

Dim wshDst As Excel.Worksheet

Dim rngDst As Excel.Range

Dim strMatch  As String

Dim strValue  As String

Dim lngSrcRow As Long

Dim lngDstRow As Long

    Set wbk = Application.ThisWorkbook

    With wbk

      Set wshSrc = .Worksheets(cstrSrcName)

      Set wshDst = .Worksheets(cstrDstName)

      strMatch = " " & .Names(cstrMatch).RefersToRange.Value & " "

    End With

    Set rngSrc = wshSrc.Range(cstrSrcRange)

    Set rngDst = wshDst.Range(cstrDstRange)

    rngDst.CurrentRegion.ClearContents

    rngSrc.Offset(-1).Copy rngDst.Offset(-1)

    With rngSrc

      Do Until IsEmpty(.Offset(lngSrcRow).Value)

        strValue = " " & .Offset(lngSrcRow).Value & " "

        If InStr(1, strValue, strMatch, vbTextCompare) Then

          .Offset(lngSrcRow).Resize(ColumnSize:=clngSrcCols) _

              .Copy rngDst.Offset(lngDstRow)

          lngDstRow = lngDstRow + 1

        End If

        lngSrcRow = lngSrcRow + 1

      Loop

    End With

ExtP:

    With Err

      If .Number Then MsgBox .Description

    End With

    On Error Resume Next

    Set rngDst = Nothing

    Set wshDst = Nothing

    Set rngSrc = Nothing

    Set wshSrc = Nothing

    Set wbk = Nothing

End Sub

Answer 5

Ciao Dodo,

anzitutto grazie per il supporto nell'altro messaggio.

Questa tua macro ho provato ad inserirla ma mi evidenzia in rosso la riga

mese=Range"A1" 

non conoscendo VBA non so cosa fare,

Sto comunque lavorando su un altro suggerimento molto interessante sottopostomi da Maurizio-

Grazie di nuovo

Roberto