You are here:---Rispondi a: [RISOLTO] Controllo doppioni
Rispondi a: [RISOLTO] Controllo doppioni2019-04-28T18:04:12+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Controllo doppioni Rispondi a: [RISOLTO] Controllo doppioni

BySalvBySalv
Amministratore del forum
    Post totali: 479

    Ciao Kriss ecco il file, ho modificato le macro in modo che facciano il loro lavoro, questa nel modulo di “Questo_foglio_di_lavoro”

    Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
    Dim Cod, dd
    If Not Intersect(Target, [E:E]) Is Nothing Then
        r = Target.Row
        c = Target.Column
        If r < 15 Then Exit Sub
        Tot = Target
        Cod = Cells(r, c - 2)
        dd = Cells(r, c - 1)
        If Cod = "" Or Cod = "CODICE" Then GoTo 1
        Call VediDopp1(Cod, dd)
    1 End If
    End Sub

    e quest’altra nel modulo3

    Sub VediDopp1(Cod, dd)
    Dim r, c, x, y, z, m, n, d, sh, k, t, fg, Arry
    Arry = Array([Pippo], [Pluto]) 'aggiungere gli altri nomi dei codici esclusi tra parentesi quadre
    fg = ActiveSheet.Name
    Application.ScreenUpdating = False
    For x = 1 To Sheets.Count
        sh = Sheets(x).Name
        Select Case sh
            Case "FoglioDaEscludere1", "FoglioDaEscludere2", "TempData"
            Case Else
                Sheets(sh).Select
                For y = 15 To Cells(Rows.Count, 3).End(xlUp).Row
                    For Each n In Arry
                        k = n
                        For m = 1 To UBound(k)
                            If Cod = k(m, 1) Then t = 1: GoTo 1
                        Next m
                    Next n
                    If Cells(y, 3) = Cod Then
                        For z = 6 To 25
                            If Cells(y, z) <> "" Then d = d & Cells(y, z) & ","
                        Next z
                    End If
                Next y
        End Select
    Next x
    1:
    Sheets(fg).Select
    Application.ScreenUpdating = True
    If t = 1 Then
        MsgBox "Codice non incluso nella ricerca", vbInformation, "Lista seriali assegnati"
        Exit Sub
    End If
    If d = "" Then
        MsgBox "Seriali assegnati al codice " & Cod & "-" & dd & Chr(10) & Chr(10) & "Nessuno", vbInformation, "Lista Seriali assegnati"
    
    Else
        MsgBox "Seriali assegnati al codice " & Cod & "-" & dd & Chr(10) & Chr(10) & d, vbInformation, "Lista Seriali assegnati"
    End If
    End Sub

    adesso quando selezioni un codice escluso ti esce il messaggio dell’esclusione dalla ricerca.

    un ultima cosa quando aggiungi una nuova riga per seriali oltre i 20 devi anche inserire ad inizio il codice e modello, altrimenti non viene conteggiata, in quanto non riporta il Codice.

    il link al file, le macro già sono inserite
    http://www.filedropper.com/fogliidenticifunziona_1

    Fai sapere come va, Ciao By Sal :bye:

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi