Verifica e avviso assenza nome da elenco

[BG66]

Buonasera a tutti,
il grado di autonomia acquisita ( e anche lo sviluppo di un file usando FileMAker ) mi ha tenuto lontano dal blog!!

Su questo caso sono piantato da giorni, in pratica:
a) ho dei fogli di lavoro "Fact01(DIP)"; "Fact02(DIP)"; etc che contengono il nome dei lavoratori (si ripetono in maniera random).
b) Ho il foglio appoggio che (scritto a mano) riassume in maniera univoca i nomi

Cosa vorrei fare:
Una macro che match i nomi dei fogli "Fact" con l'elenco presente in Appoggio e mi avvisi nel caso che nella trascrizione abbia saltato qualche nome.
Non propongo nulla perchè non sono riuscito a creare nulla .

Grazie dell'aiuto se volete.
Gene

https://www.dropbox.com/s/k2hn8lykgw6skg3/Verifica%20elenco-forum.xlsm?dl=0

[Anthony47]

C'e' qualcosa di strano in quel che chiedi...
Ad esempio, perche' nei fogli FACT non inserisci una convalida che obbliga a inserire solo nominativi presenti sul foglio Appoggio?

In alternativa, perche' scrivere a mano i nominativi e usare la macro come controllo di quanto fatto? Non sarebbe piu' furbo fare in modo che la macro compili l'elenco dei nominativi presenti?

Insomma, prima di proporre qualcosa che non mi convince ti chiedo di procedere con un supplemento di analisi e quindi di descrizione.

Ciao

[Marius44]

Ciao Gene e bentornato

Condivido quanto detto da Athony (ciao) ma vorrei lo stesso proporre qualcosa, e cioè una macro che faccia il tuo lavoro (e non manualmente).
Cosa dovrebbe fare questa macro:
'spazzola tutti i fogli i cui primi 4 caratteri sono Fact
'assegna ad una collection con chiave (quindi elenco univoco)
' il dato in col.D e il dato in col.E
'scrive i dati come richiesto nel Foglio Appoggio
' prima riga libera con un rigo in più quando cambia foglio
'distrugge la collection quando cambia foglio e ne crea un'altra.

Si può fare?
Ciao,
Mario

[BG66]

C'e' qualcosa di strano in quel che chiedi...
Ad esempio, perche' nei fogli FACT non inserisci una convalida che obbliga a inserire solo nominativi presenti sul foglio Appoggio?

I fogli FACT sono quelli che fanno partire l'intera analisi e quindi sono da considerarsi "sorgenti"

In alternativa, perche' scrivere a mano i nominativi e usare la macro come controllo di quanto fatto? Non sarebbe piu' furbo fare in modo che la macro compili l'elenco dei nominativi presenti?

Cosa dovrebbe fare questa macro:
'spazzola tutti i fogli i cui primi 4 caratteri sono Fact
'assegna ad una collection con chiave (quindi elenco univoco)
' il dato in col.D e il dato in col.E
'scrive i dati come richiesto nel Foglio Appoggio
' prima riga libera con un rigo in più quando cambia foglio
'distrugge la collection quando cambia foglio e ne crea un'altra.

Oggettivamente non volevo caricare troppo l'aiuto richiesto.
Quello che entrambi proponete è l'ideale, in pratica se ho ben capito la macro prende atto dei nomi presenti nei fogli FACT e mi crea un elenco in Appoggio.

Sono pronto a rimboccarmi le maniche.. indicazioni su come procedere e ci provo.

Grazie
Gene

[Marius44]

Ciao Gene
poichè so che sei "oberato" di lavoro ti sottopongo la mia macro

Codice: Seleziona tutto

Option Explicit

Sub riporta()
'
Dim nomi As Collection, nm
Dim ur As Long, i As Long, j As Long, k As Long
Dim nome As String

'Sheets("Appoggio").Cells.ClearContents           '<== questa riga cancella l'intero foglio
For i = 1 To Sheets.Count
  If Left(Sheets(i).Name, 4) = "Fact" Then
    Set nomi = New Collection
    For j = 2 To Sheets(i).Cells(Rows.Count, 4).End(xlUp).Row
      On Error Resume Next
      nome = Sheets(i).Cells(j, 4) & "," & Sheets(i).Cells(j, 5)
      nomi.Add nome, CStr(nome)
      On Error GoTo 0
    Next j
    ur = Sheets("Appoggio").Cells(Rows.Count, 4).End(xlUp).Row + 1
    For k = 1 To nomi.Count
      With Sheets("Appoggio")
        nm = Split(nomi(k), ",")
        .Cells(ur, 6) = nm(0) & " " & nm(1)
        .Cells(ur, 4) = nm(0)
        .Cells(ur, 5) = nm(1)
      End With
      ur = ur + 1
    Next k
    Sheets("Appoggio").Cells(ur, 4) = "*"
    Set nomi = Nothing
  End If
Next i
End Sub



Fai sapere. Ciao,
Mario

[BG66]

Ciao Mario,
grazie a nome delle mie coronarie.
Obiettivo raggiunto. Ho solo spostato i riferimenti nella colonna appoggio per compilare le colonne A-B-C.

Mentre, so che ti stò dando un dolore visti i tuo insegnamenti ma i tentativi di iniziare a scrivere dalla riga 3 e non dalla 2 NON sono andati a buon fine

Codice: Seleziona tutto

Option Explicit

Sub riporta()
'by Marius44
Dim nomi As Collection, nm
Dim ur As Long, i As Long, j As Long, k As Long
Dim nome As String

'Sheets("Appoggio").Cells.ClearContents           '<== questa riga cancella l'intero foglio
For i = 1 To Sheets.Count
  If Left(Sheets(i).Name, 4) = "Fact" Then
    Set nomi = New Collection
    For j = 2 To Sheets(i).Cells(Rows.Count, 4).End(xlUp).Row
      On Error Resume Next
      nome = Sheets(i).Cells(j, 4) & "," & Sheets(i).Cells(j, 5)
      nomi.Add nome, CStr(nome)
      On Error GoTo 0
    Next j
    ur = Sheets("Appoggio").Cells(Rows.Count, 4).End(xlUp).Row + 1
    For k = 1 To nomi.Count
      With Sheets("Appoggio")
        nm = Split(nomi(k), ",")
        .Cells(ur, 3) = nm(0) & " " & nm(1)
        .Cells(ur, 2) = nm(0)
        .Cells(ur, 1) = nm(1)
      End With
      ur = ur + 1
    Next k
    Sheets("Appoggio").Cells(ur, 4) = "*"
    Set nomi = Nothing
  End If
Next i
End Sub

Ovviamente potrei by-passare il tutto modificando le intestazioni... ma per me..il capire viene prima della ragion di stato!!

Gene

[Anthony47]

Oggettivamente non volevo caricare troppo l'aiuto richiesto

A volte, lo sai, e' piu' facile fare che controllare quello gia' fatto...

Ingelosito dalla bella soluzione di Marius, propongo quest'altra forse piu' semplice da adattare:

Codice: Seleziona tutto

Sub riporta2()
Dim I As Long, J As Long
Dim CDest As String, ShApp As Worksheet, myMatch, myNext, RStart As Long
'
CDest = "A"                         '<<< La colonna iniziale in cui vuoi i risultati (3 colonne saranno usate)
RStart = 3                          '<<< Prima riga su cui scrivere i risultati
Set ShApp = Sheets("Appoggio")      '<<< Il foglio in cui vuoi i risultati
'
ShApp.Cells(1, CDest).Resize(Rows.Count, 3).Clear       'Pulisce le tre colonne dei risultati
For I = 1 To Sheets.Count                               'Esamina ogni foglio
    If Left(Sheets(I).Name, 4) = "Fact" Then
        'Scrive NomeFoglio:
        myNext = ShApp.Cells(Rows.Count, CDest).End(xlUp).Offset(1, 0).Row: If myNext < RStart Then myNext = RStart
        ShApp.Cells(myNext, CDest) = Sheets(I).Name
        'Formatta NomeFoglio:
        ShApp.Cells(myNext, CDest).Font.Bold = True
        ShApp.Cells(myNext, CDest).HorizontalAlignment = xlCenter
        'Scrive Intestazioni:
        ShApp.Cells(myNext + 1, CDest).Resize(1, 3) = Array("COGNOME", "NOME", "NOMINATIVO COMPLETO")
        'Formatta Intestazioni:
        ShApp.Cells(myNext + 1, CDest).Resize(1, 3).Font.Bold = True
        ShApp.Cells(myNext + 1, CDest).Resize(1, 3).HorizontalAlignment = xlCenter
        'Esamina le righe:
        For J = 2 To Sheets(I).Cells(Rows.Count, 4).End(xlUp).Row
            'Verifica se Nominativo gia' presente:
            myMatch = Application.Match(Sheets(I).Cells(J, 4).Value & " " & Sheets(I).Cells(J, 5).Value, ShApp.Cells(1, CDest).Offset(0, 2).Resize(10000, 1), False)
            If IsError(myMatch) Then
                'Se NON presente, aggiunge:
                myNext = ShApp.Cells(Rows.Count, CDest).End(xlUp).Row + 1
                ShApp.Cells(myNext, CDest).Value = Sheets(I).Cells(J, 4)
                ShApp.Cells(myNext, CDest).Offset(0, 1).Value = Sheets(I).Cells(J, 5)
                ShApp.Cells(myNext, CDest).Offset(0, 2).Value = Sheets(I).Cells(J, 4) & " " & Sheets(I).Cells(J, 5)
            End If
        Next J
        'Lascia uno spazio a fine elenco:
        ShApp.Cells(Rows.Count, CDest).End(xlUp).Offset(1, 0) = "'"
  End If
Next I
End Sub


Le righe marcate <<< vanno personalizzate come da commento

Ciao a tutti!

[BG66]

Ciao
rinnovo ed implemento il grazie ad entrambi per le soluzioni super.
Per il definitivo RISOLTO attendo la risposta di Mario sul "problema prima riga da scrivere"

Gene

[Marius44]

Ciao Gene
Premetto che sono "sopra una nuvoletta" per i complimenti di Anthony ( grazie ) e rispondo adesso che mi son rimesso in "plancia".
Se vuoi scrivere dalla riga 3 aggiungi la seguente riga dopo questa
ur = Sheets("Appoggio").Cells(Rows.Count, 4).End(xlUp).Row + 1

Codice: Seleziona tutto

if ur <3 then ur = 3

dovrebbe bastare.
Ciao,
Mario

[BG66]

[RISOLTO]
Ciao Mario,

Premetto che sono "sopra una nuvoletta" per i complimenti di Anthony ( grazie )

sai bene che per il mio Tutor farei questo e altro... per fargli beccare i complimenti!!
PS: Comunque meritatissimi...ricordando agli imberbi che il 44 non indica il numero dei "gatti in fila" ma la composizione "chimica" del materiale cromosomico del grande Mario!! .

Buonaserata
Gene

[Marius44]

Ciao
Dai, non farmi arrossire

E poi, come puoi vedere, Anthony non è intervenuto perchè sa che i complimenti non sono tutti meritati

Ciao e buona serata anche a voi tutti,
Mario