Importare in un Foglio Elenco Nomi da un altro Foglio solo se hanno valore "SI"

Question

Buon Giorno a Tutti

non riesco a trovare la formula che mi permetta di prelevare i Nomi da un Elenco Nomi nel Foglio1  e trascriverli nel Foglio2 ....solo se la condizione e'  "SI"    mi spiego ...

Nel Foglio1     cella  A1  "SI"  oppure  "NO"    cella    B1   "Pippo"

                                  A2  "SI"    """"      "NO"     """      B2   "Topolino" 

                                  A3    """    """       """"       """       B3   "Minny"   ........ eccetera fino a  A1500  ,   B1500

L'elenco nel Foglio1  e' ordinato in ordine alfabetico  A-Z  e di conseguenza nel Foglio2 dovra' essere equivalente 

Pensavo di utilizzare =cerca.vert(              ... ma mi sono incasinato ...perche' non riesco a dare univocita'  ai nomi

........................ una dritta e' bene accetta   GRAZIE     Claudio P

Answer 1

Ciao Claudio,

In alternativa, potrei postare una routine VBA da assegnare ad un pulsante.

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Menù | Inserisci | Modulo (oppure Alt+IM) per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range, critRng As Range

    Dim vArrIn As Variant, vArrOut() As Variant

    Dim vArrKeys As Variant

    Dim oDic As Object

    Dim sStr As String

    Dim i As Long

    Dim LRow As Long

    Const sPrimoFoglio As String = "Foglio1"              '<<=== Modifica

    Const sSecondoFoglio As String = "Foglio2"          '<<=== Modifica

    Const iRigaIntestazioni As Long = 4 '<<=== Modifica

    Const sCellaCriterio As String = "D2"                     '<<=== Modifica

    Const sPrimaCellaReport As String = "A1"              '<<=== Modifica

    Const sIntestazione As String = _

                              "Nomi Univoci "                          '<<=== Modifica

    Set WB = ThisWorkbook

    With WB

        Set srcSH = WB.Sheets(sPrimoFoglio)

        Set destSH = WB.Sheets(sSecondoFoglio)

    End With

    With srcSH

        LRow = LastRow(srcSH, .Columns("A:A"))

        Set srcRng = .Range("A" & iRigaIntestazioni + 1 & ":B" & LRow)

        Set critRng = .Range(sCellaCriterio)

    End With

    Set destRng = destSH.Range(sPrimaCellaReport)

    vArrIn = srcRng.Value

    Set oDic = CreateObject("Scripting.Dictionary")

    With oDic

        .CompareMode = 0

        For i = LBound(vArrIn) To UBound(vArrIn)

            sStr = critRng.Value

            If UCase(vArrIn(i, 1)) = UCase(critRng.Value) Then

                If Not .exists(sStr) Then

                    .Add Key:=vArrIn(i, 2), Item:=vbNullString

                End If

            End If

        Next i

        vArrKeys = Application.Transpose(SortedList(.keys))

        destRng.Offset(1).Resize(.Count).Value = vArrKeys

        destRng.Cells(1).Value = sIntestazione

    End With

End Sub

'--------->>

Public Function SortedList(V As Variant)

    Dim oSortedList As Object

    Dim arrOut() As Variant

    Dim sStr As String

    Dim i As Long

    Set oSortedList = CreateObject("System.Collections.Sortedlist")

    With oSortedList

        For i = LBound(V) To UBound(V)

            sStr = V(i)    ', 1)

            If Not sStr = vbNullString Then

                If Not .ContainsKey(sStr) Then

                    .Add Key:=sStr, Value:=i

                End If

            End If

        Next i

        ReDim arrOut(1 To .Count)

        For i = 0 To .Count - 1

            arrOut(i + 1) = .GetKey(i)

        Next i

    End With

    SortedList = arrOut

End Function

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester | Esegui

Potresti scaricare il mio file di prova Claudio20160703.xlsm a:

https://www.dropbox.com/s/mmxsc0smn4e4zk1/Claudio20160703.xlsm?dl=0

===

Regards,

Norman


Answer 2

Ciao Claudio,

A questo punto se il problema dell'errore di run time che ti ho segnalato e' risolvibile  senza troppe complicazioni per te ....... beh !!!   non esisterebbe nessun problema di protezione  e il file sarebbe piu' leggero e meno impegnativo per il PC  che utilizzano quelli dell'associazione (non penso che sia un mostro di potenza ).

Credo sia probabile che lo scaricamento del Microsoft .NET Framework 3.5 e il suo installazione, come suggerito da me, dovrebbero risolvere il problema segnalato, ovvero:

Errore Run Time  2146232576(80131700)

Errore di Automazione 

Facci sapere.

===

Regards,

Norman

Answer 3

ciao Norman

hai assolutamente ragione e oltretutto siccome chi utilizzera' questo file e' una signora ....non piu' giovanissima che fa' parte di una associazione di volontariato , che mi ha chiesto un favore , esiste la forte probabilita' ...che cancelli o digiti dati in una cella che contiene formule ...e ...non e' possibile proteggere le celle perche' altrimenti quando deve impostare l'area di stampa deve fare delle operazioni che sicuramente non e' in grado di eseguire ....(rimuovi protezione foglio e sopratutto seleziona celle da proteggere ....!! ) .

Tanto che avevo pensato di inserire un Pulsante associato ad una Macro   Proteggi Foglio (lo avevi realizzato tu per me'.) in maniera che quando deve impostare l'area di stampa (anche qui con un pulsante con Macro ...anche questa realizzata da te ...... !!! ) ...prima rimuove la protezione ...click su Pulsante STAMPA ,  ...finito click  su Pulsante  PROTEGGI

A questo punto se il problema dell'errore di run time che ti ho segnalato e' risolvibile  senza troppe complicazioni per te ....... beh !!!   non esisterebbe nessun problema di protezione  e il file sarebbe piu' leggero e meno impegnativo per il PC  che utilizzano quelli dell'associazione (non penso che sia un mostro di potenza ).

Grazie  anche a nome loro    ciao   Claudio P

Answer 4

Ciao Claudio,

ho trovato una soluzione empirica , con semplici formule ....

Bravo!

Credo che sia sempre laudible di cercare una soluzione da solo; in questo modo, si può imparare molto.

Foglio1

Colonna   A   Numerare Progressivamente le celle solo se nella colonna  B  la condizione  e'  "SI"

Colonna   B   Condizione     "SI"   oppure  "NO"

Colonna   C   Se  Colonna   B = "SI"   allora  NOME altrimenti  "" (nulla)

Colonna   D   NOME

in  A2  inserito Formula  =se(Lunghezza(C2)>1;MAX(A$1:C1)+1;"") numera progressivamente le celle nella colonna A  solo se in C  ci sono Valori

in  C2  inserito Formula   =se(B2="SI";D2;"")   riporta nella cella C2  il NOME solo se la condizione in B2  e' "SI"

Foglio2

Numerate Progressivamente le celle Colonna A    da  A2  a  A1501   ( da 1  a 1500 )

Colonna  B  (NOME)   inserito Formula    =cerca.vert(A2;'Foglio1'!$A$2:$D$1501;4;FALSO)

...quindi  nel Foglio1   ho questa situazione

A2    1       B2  "SI"      C2  PIPPO              D2  PIPPO

A3             B3  "NO"   C3                          D3  MINNY

A4    2       B4  "SI"      C4  PLUTO             D4  PLUTO

A5    3       B5  "SI"      C5  PAPERINO       D5  PAPERINO

nel Foglio2  il cerca.vert   importa solo i dati  riferiti ai numeri della Colonna A

.......Funziona .....   certo che con il codice si eviterebbero tutti i riferimenti tra i due Fogli  e sarebbe piu' elegante 

Avrai potuto già notare alcuni tipi di problemi che possono derivare dall'uso di un numero eccessivo di formule, o di fogli di lavoro di grandi dimensioni. Pertanto, se il file che di interesse fosse del tipo discusso in un altro tuo thread recente, vorrei suggerire che una soluzione VBA potrebbe essere più appropriata in tale circostanze particolari; tuttavia, solo tu puoi giudicare e decidere!

Di nuovo applaudo la tua volontà di cercare soluzioni da solo.

Alla prossima.

===

Regards,

Norman


Answer 5

Ciao Claudio,

.....scaricato tuo file esempio 

fatto girare .....

Errore Run Time  2146232576(80131700)

Errore di Automazione

                    Debug

evidenziata questa riga     Set oSortedList = CreateBject("System.Collections.Sorted List")

devo aggiungere qualche riferimento a delle librerie ....???

No ma scarica ed installa Microsoft .NET Framework 3.5 da Microsoft:

https://www.microsoft.com/en-us/download/details.aspx?id=21

===

Regards,

Norman