Intercettare codici duplicati nei 3 fogli precedenti a quello attivo

[nicola spanuPartecipante nicola spanu]

Ciao A tutti

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Source As Range)
Dim c As Range, s As String, Ws As Variant
Dim wsheets As Variant      'array che contiene il foglio prima e quello dopo

    If Intersect(Source, sh.Range("C:D")) Is Nothing Then Exit Sub
    If Source.Cells.Count > 1 Then Exit Sub
    If Source.Row <= 8 Or Source = "" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    s = ""
    
    If sh.Index = 1 Then
        wsheets = Array(sh.Next)
    ElseIf sh.Index = ThisWorkbook.Sheets.Count Then
       wsheets = Array(sh.Previous)
    Else
        wsheets = Array(sh.Previous, sh.Next)
    End If
    
    For Each Ws In wsheets
        Set c = Ws.Range("C:D").Find(Source, Lookat:=xlWhole)
        
            If Not (c Is Nothing) Then
                If s = "" Then
                    s = "Articolo usato nei fogli: " & Ws.Name
                Else
                    s = s & "-" & Ws.Name
            End If
        
             'inserisce in colonna M ("Note") i dati recuperati dal foglio sorgente
            sh.Cells(Source.Row, "M") = s
        End If
    Next

    Application.ScreenUpdating = False
    Application.EnableEvents = True
End Sub

il codice sotto ricerca se ci sono dei duplicati nel foglio prima e dopo quello attivo.

Ho bisogno di modificarlo affinchè la ricerca venga fatta solo nei 3 fogli precedenti.

Vi ringrazio in anticipo per l'aiuto

Edit by VF: ho riformattato il codice perché altrimenti era difficile leggerlo 🙂

[Aldo ErcoliniPartecipante Aldo Ercolini Karma: 19 pts]

Prova cosi':

`Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Source As Range)
Dim c As Range, s As String, Ws As Variant
Dim wsheets(1 to 3) As Variant      'array che contiene il foglio prima e quello dopo
Dim i as Long

    If Intersect(Source, sh.Range("C:D")) Is Nothing Then Exit Sub
    If Source.Cells.Count > 1 Then Exit Sub
    If Source.Row <= 8 Or Source = "" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    s = ""
    
    If sh.Index = ThisWorkbook.Sheets.Count Then
       For i = 1 to 3
         wsheets(i) = sh.Previous)
       next
    End If
    
    For Each Ws In wsheets
        Set c = Ws.Range("C:D").Find(Source, Lookat:=xlWhole)
        
            If Not (c Is Nothing) Then
                If s = "" Then
                    s = "Articolo usato nei fogli: " & Ws.Name
                Else
                    s = s & "-" & Ws.Name
            End If
        
             'inserisce in colonna M ("Note") i dati recuperati dal foglio sorgente
            sh.Cells(Source.Row, "M") = s
        End If
    Next

    Application.ScreenUpdating = False
    Application.EnableEvents = True
End Sub`

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Battuto sul tempo... cancello il mio post   

Nota: l'ultimo Application.ScreenUpdating deve essere settato su True.

[Aldo ErcoliniPartecipante Aldo Ercolini Karma: 19 pts]

vecchio frac ha scritto:

Battuto sul tempo... cancello il mio post

Questa me la segno sul calendario        

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Aldo Ercolini ha scritto:

Questa me la segno

In verità non ho allegato niente perchè la mia proposta è sostanzialmente identica alla tua. Segnale che era quindi una buona soluzione   

[nicola spanuPartecipante nicola spanu]

Ciao grazie mille per l'aiuto

....Il codice va in Debug...

Non capisco se ho sbagliato Qualcosa

Allego il File di esempio

 

[Aldo ErcoliniPartecipante Aldo Ercolini Karma: 19 pts]

Non hai allegato niente, comunque ho dimenticato di togliere la parentesi in fondo

 wsheets(i) = sh.Previous )

 

[nicola spanuPartecipante nicola spanu]

Si avevo tolto la parentesi.

Ma continua andare in errore

Provo a nuovamente ad allegare il file

 

Allegati:

You must be logged in to view attached files.

[Aldo ErcoliniPartecipante Aldo Ercolini Karma: 19 pts]

Prova con il file che ti allego. Ho cambiato logica.

Allegati:

You must be logged in to view attached files.

[nicola spanuPartecipante nicola spanu]

Ottimo,

ora funziona alla grande.

Saresti cosi gentile da spiegarmi questa logica.

Ti ringrazio tantissimo  

 

[nicola spanuPartecipante nicola spanu]

Piccolo problema

ho inserito altri fogli nel progetto e ho provato a cercare la corrispondenza dal 7° foglio - 3 fogli e dal 4° Foglio -3 fogli.

Nel 7° foglio tutto ok.

Nel 4° foglio Debug.

In questo file i fogli non sono definiti ma possono variare.

Può essere questo il problema?

Allegati:

You must be logged in to view attached files.

[nicola spanuPartecipante nicola spanu]

i = ActiveWorkbook.Worksheet

If sh.Index = ActiveWorkbook.Worksheet Then

 

Ho modificato il codice in questo modo ....

Ossia parto dal foglio attivo per poi tornare indietro

Non funziona...Sto sbagliando il metodo

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Visto che c'è qualche difficoltà, mi permetto di allegare il mio codice, che non avevo più postato.
Ditemi se funziona oppure no.

Option Explicit

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal source As Range)
Dim c As Range, s As String, ws As Worksheet
Dim wsheets As Variant      'array che contiene il foglio prima e quello dopo
Dim i As Integer

    If Intersect(source, sh.Range("C:D")) Is Nothing Then Exit Sub
    If source.Cells.Count > 1 Then Exit Sub
    If source.Row <= 8 Or source = "" Then Exit Sub
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    s = ""
    
    For i = sh.Index - 3 To sh.Index
        If i > 0 Then
            s = s & Worksheets(i).Name & ","
        End If
    Next
    s = Left$(s, Len(s) - 1)
    wsheets = Split(s, ",")
    
    s = ""
    For Each ws In Worksheets(wsheets)
        Set c = ws.Range("C:D").Find(source, Lookat:=xlWhole)
        
            If Not (c Is Nothing) Then
                If s = "" Then
                    s = "Articolo usato nei fogli: " & ws.Name
                Else
                    s = s & "-" & ws.Name
            End If
        
            'inserisce in colonna M ("Note") i dati recuperati dal foglio sorgente
            sh.Cells(source.Row, "M") = s
        End If
    Next

    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

[nicola spanuPartecipante nicola spanu]

Ciao

Funziona alla grande...

Complimenti per il codice...  

Saresti così gentile da spigarmi questi ciclo?

For i = sh.Index - 3 To sh.Index If i > 0 Then s = s & Worksheets(i).Name & "," End If

Come fa a riconoscere il foglio Attivo?

 

 

[nicola spanuPartecipante nicola spanu]

Molto interessante anche questo codice.

Cosa vuole esprimere in parole spiciole?

s = Left$(s, Len(s) - 1)

Giuro che poi non faccio più domande.

MI piace capire e imparare dai migliori

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

vecchio frac ha scritto:

    For i = sh.Index - 3 To sh.Index
        If i > 0 Then
            s = s & Worksheets(i).Name & ","
        End If
    Next
    s = Left$(s, Len(s) - 1)
    wsheets = Split(s, ",")​

Il foglio attivo è sempre identificato dalla variabile "sh", dal momento che tutto il codice è in ThisWorkbook, all'interno dell'evento WorkBook_SheetChange. Il primo dei parametri di questo evento è "ByVal sh as Object" che identifica il foglio che sta scatenando l'evento (corrisponde ai singoli eventi WorkSheet_Change dei singoli fogli ma è intercettato a livello globale dal momento che è in ThisWorkbook).

Quindi facciamo affidamento al suo Index cioè alla sua posizione assoluta nel Workbook, retrocediamo di tre posizioni fino all'index del foglio in esame (quello che ha scatenato l'evento). Il test con If serve a evitare di considerare un valore di indice inferiore a zero, naturalmente.

Inseriamo nella variabile "s" i nomi dei singoli fogli interessati, separandoli con una virgola, perciò alla fine del ciclo potresti avere una cosa come s = "Foglio1,Foglio2, con una virgola aggiuntiva finale. Qui con l'istruzione con Left$, su cui hai chiesto lumi, interveniamo per togliere la virgola finale di troppo (quindi riassegniamo a "s" il valore di se stesso fino al suo penultimo carattere, scartando quindi la virgola finale). Questo è necessario perché l'istruzione finale assegna a wsheets i singoli valori Foglio1, Foglio2 prelevati da "s" tramite l'istruzione Split, dicendole che i valori vanno separati in corrispondenza della virgola.

nicola spanu ha scritto:

Giuro che poi non faccio più domande.

Io invece voglio che tu le faccia e ti invito a continuare a farle  

[nicola spanuPartecipante nicola spanu]

Grazi mille ancora della disponibilità.

Ormai sono anni che vi seguo e continuo a farlo.

Grazie di cuore

Segno la richiesta come risalta-.......Alla grande

   

[Autore]

Articoli