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 Norman

stavo riflettendo sulla traccia che avete suggerito ...lanciare un nuovo Thread ....

Io non lo posso fare perchè devo creare un report da un database storico  creato da terzi e credo che Claudio abbia lo stesso problema. Certo che si possa creare controlli per evitare che dati inportanti siano  trascurati ma sarebbe fuori l'ambito dell'oggetto di questo thread. Magari tu abbia dato Claudio un'idea interressante per il suo prossimo thread!

..... i dubbi che ho sono relativi al fatto che loro ogni anno quano devono fare i rinnovi delle iscrizioni ,utilizzano il il database dell'anno precedente (copia...incolla ) e appongono  "SI" , "NO"  nelle rispettive celle della colonna deputata,

esiste anche una terza condizione .....  "N"  , nuovo iscritto  , che per ora non viene monitorata in quanto diventa un'aggiunta ai nominativi che hanno rinnovato e sara' quindi il database di riferimento per l'anno successivo .

Quindi se io automatizzo la procedura di inserimento dei dati tramite UserForm con ListBox o ComboBox , TextBox e CommandButton vari Rischio di imporre all'operatore (...la signora del caso ...) di reinserire tutti i dati di 1300 nominativi (cognome ,nome,............ etc ) .

Inoltre ....controlli ....spesso per chi inserisce i dati nell'anagrafica e' impossibile ottenere tutti i dati dell'iscritto (non e' un ente pubblico ...) quindi questi controlli non dovrebbero impedirgli di continuare le operazioni di inserimento se un campo non viene compilato  (questa istruzione VB non l'ho ancora  imparata !!!! ) .

Accetto consigli (io grazie a voi ho gia' tutta una serie di UserForm e moduli che potrei adattare allo scopo )

Grazie   Claudio P

Answer 3

ciao Norman

scusa il ritardo nella risposta ....ogni tanto ...lavoro ....

scaricato file esempio ...fatto girare

SOB !                    Errore di Run Time  '5'

                            Chiamata di Routine o Argomento non Validi

                                                Debug

evidenziata riga    Add Type :=Lexpression, Formula1:= _

                               "=AND(LEN ($A1)>0,Mod(Row(), 2 = 0)"

.............devo buttare il PC ...........................................  :))     ciao  GRAZIE   Claudio P

Answer 4

ciao

l'Omocodia deve essere una brutta malattia .... :-))

Comunque a loro il C.F   serve solo per registrarlo nell'anagrafica .....non ne fanno poi nessun uso istituzionale ....

Ciao   Claudio P

Answer 5

 .... ho adattato un programmino trovato in rete che genera un C.F  alla volta in maniera che ,Tramite UserForm ,mano a mano che inserisce i dati (nome,cognome,data,luogo di nascita e sesso ) inserisce automaticamente nella cella deputata il C.F  ....funziona..

Funziona .... a meno che non ti campiti uno dei 30.000 casi di omocodia ... :-)