nome lavoratore in date specifiche (festivita)

[raimea]

ciao
tramite una macro vorrei prelevare il nome dei dipendenti
che hanno lavorato in giornate festive.

il foglio da compilare e' feste
il nome del foglio in cui andare a cercare e' indicato in D4 (calendario)
la data da cui partire la ricerca indicata in D3

la data da cercare e' indicata da riga E5
per la stessa festivita ci possono essere piu dipendenti di turno.

nella casella del dipendente di turno riportare la lettera o il numero
trovato nel fgl calendario , di solito sempre la lettera B

il nome del dipendente riportalo da col D6

vi allego il file

https://www.dropbox.com/s/f1hxiwjbrddh4la/festivita.rar?dl=0

grazie

[raimea]

azz.....

ho dimenticato di specificare cosa va cercato in fgl calendario ?
riferito alla data indicata in fgl feste !!!!

vannno ricercati e riportati i cod B 1 2
tutto il resto non deve essere considerato x le date indicate

ciao

[Anthony47]

Se ho capito allora potrebbe aiutare questa macro:

Codice: Seleziona tutto

Sub CkHolid()
Dim HDArr, I As Long, mHoly, llFor
Dim LastW As Long, TWsh As Worksheet
'
llFor = Array("B", "1", "2")                    '<<< I Turni festivi da cercare
'
Sheets("Feste").Select
Set TWsh = Sheets(Range("D4").Value)
'
Range("D6").Resize(200, 30).ClearContents       '<<< ??? azzera l'area dei risultati??
'
LastW = TWsh.Cells(Rows.Count, 1).End(xlUp).Row
HDArr = Range(Range("E5"), Range("E5").End(xlToRight)).Value
For I = 1 To UBound(HDArr, 2)
    mHoly = Application.Match(CLng(HDArr(1, I)), TWsh.Range("A2").Resize(1, 1000), False)
    If Not IsError(mHoly) Then
        For j = 3 To LastW
'        Debug.Print TWsh.Cells(j, mHoly).Address
            If Not IsError(Application.Match(TWsh.Cells(j, mHoly).Value, llFor, False)) Then
                mynext = Application.Match(TWsh.Cells(j, "D").Value, Range("D1").Resize(200, 1), False)
                If IsError(mynext) Then
                    mynext = Cells(Rows.Count, "D").End(xlUp).Row + 1
                    Cells(mynext, "D").Value = TWsh.Cells(j, "D").Value
                End If
                Cells(mynext, 5 + I - 1).Value = TWsh.Cells(j, mHoly).Value
            End If
        Next j
    End If
Next I
MsgBox ("Completato...")
End Sub

Va messa in un modulo standard del vba.
Al momento, la macro azzera l'area dei risultati prima di cominciare; se questo non va bene allora cerca ed elimina la riga marcata '<<< ???

Fai sapere...

[raimea]

ciao
e' tutto ok
fa proprio cio che chiedevo

grazie

[raimea]

ciao
ho trovato un piccolo bug

se trova il cod LL
SOLO nella data del 31-12-19 nel fogl calendario
riferito alla data da cercare in fgl feste

ne preleva il nome del dipendente
e lascia la casella vuota non riporta nulla in fgl feste



il codice LL non va considerato
non va riportato il nome del dipendente

grazie

ciao

[Anthony47]

Non capisco quel che dici...
La macro compila lo specchietto per TUTTE le festivita' presenti da E5 verso destra; quindi quei nominativi sono presenti per le altre date precedenti. Forse vuoi che vengano esaminate solo le date a partire da una data specifica, es quella in D3; nel qual caso devi sostituire If Not IsError(mHoly) Then con

Codice: Seleziona tutto

If Not IsError(mHoly) And HDArr(1, I) >= Range("D3").Value Then


Ciao

[raimea]

ciao
SI ora tutto ok

contralla dalla data scritta in D3 in avanti

grazie

[raimea]

ciao
sto facendo girare questa macro su piu file/ fogli
con stesse impostazioni , ma in questo file mi va in errore

la macro >>> CkHolid

pur prelevando cio che cerco poi si blocca




vi allego il file

https://www.dropbox.com/s/41hapszduvuotaj/festivi.rar?dl=0

grazie
ciao

[Anthony47]

L'attuale Sub CkHolid va in crisi quando l'elenco contiene una sola festivita'; modifica questa parte della macro come segue:

Codice: Seleziona tutto

LastW = TWsh.Cells(Rows.Count, 1).End(xlUp).Row
HDArr = Range(Range("E5"), Range("AZ5").End(xlToRight)).Value       'Riga Modificata
For I = 1 To UBound(HDArr, 2)
    If HDArr(1, I) = "" Then Exit For                               'Riga aggiunta
    mHoly = Application.Match(CLng(HDArr(1, I)), TWsh.Range("A2").Resize(1, 1000), False)


Questa modifica gestisce da 0 fino a 50 festivita'

Ciao

[raimea]

ciao
correzione fatta
tutto ok

grazie

[raimea]

ciao
tramite la macro ckholid in mod 1
prelevo il nome dei tecnici di turno e il relativo turno,
nelle date riportate in riga 5 di fgl feste.

vorrei far riportare anche i tecnici
che nelle stesse date di riga 5 sono reperibili

la reperibilita' e riportata nel fogl >>> bn is fonia
ma nella riga SOTTO alla riga dei turni.

la lettera da cercare e' la R e la scritta Reper.
che purtroppo mi hanno messo in unione celle !!!

vorrei riportare il tec che in quel giorno e' reperibile
scrivendo una R con sfondo giallo

vi allego il file
https://www.dropbox.com/s/tiytko5z5le0up4/reperbl.rar?dl=0

NB
i fogli in cui poi dovro' operare sono molti
e vengono distinti dalla cella D4 del fgl feste


ciao

[Anthony47]

Avreai modificato la Sub CkHolid come segue:

Codice: Seleziona tutto

Sub CkHolid()
Dim HDArr, I As Long, mHoly, llFor
Dim LastW As Long, TWsh As Worksheet
''-----------------------------------------------
' maggio 20 pc-facile
' serve prelevare chi di turno in festivita
'  http://www.pc-facile.com/forum/viewtopic.php?f=26&t=111366&p=653980&sid=0ca4f906125bab64240af182d6271f8f#
'-------------------------------------------------

   UserForm1.Show vbModeless ' attiva immagine attendi
      DoEvents

llFor = Array("B", "1", "2", "R", "Reper.")                  '<<< I Turni festivi da cercare                '###
'
 
 
Set TWsh = Sheets(Range("D4").Value)
'
Range("D6").Resize(200, 40).ClearContents       '<<< ??? azzera l'area dei risultati?? fino riga 200 col 40
Range("D6").Resize(200, 40).Interior.Color = xlNone     '<<< ??? azzera l'area dei risultati?? fino riga 200 col 40   '###
'
LastW = TWsh.Cells(Rows.Count, 1).End(xlUp).Row

HDArr = Range(Range("E5"), Range("AZ5").End(xlToRight)).Value  ' AZ fin dove controlla
For I = 1 To UBound(HDArr, 2)
 If HDArr(1, I) = "" Then Exit For
    mHoly = Application.Match(CLng(HDArr(1, I)), TWsh.Range("A2").Resize(1, 1000), False)
   
    If Not IsError(mHoly) And HDArr(1, I) >= Range("D3").Value Then  ' control le date da D3 in avanti
    ' If Not IsError(mHoly) Then               ' controlla tutte date non fa rif a D3   
        For J = 3 To LastW
'        Debug.Print TWsh.Cells(j, mHoly).Address
            If Not IsError(Application.Match(TWsh.Cells(J, mHoly).MergeArea.Cells(1, 1).Value, llFor, False)) Then              '###
                mynext = Application.Match(TWsh.Cells(J, "D").MergeArea.Cells(1, 1).Value, Range("D1").Resize(200, 1), False)   '###
                If IsError(mynext) Then
                    mynext = Cells(Rows.Count, "D").End(xlUp).Row + 1
                    Cells(mynext, "D").Value = TWsh.Cells(J, "D").MergeArea.Cells(1, 1).Value                                   '###
                End If
                Cells(mynext, 5 + I - 1).Value = Left(TWsh.Cells(J, mHoly).MergeArea.Cells(1, 1).Value, 1)                      '###
                If Cells(mynext, 5 + I - 1).Value = "R" Then Cells(mynext, 5 + I - 1).Interior.Color = RGB(255, 255, 200)       '###
            End If
        Next J
    End If
Next I
'---------------------------------------------------
Call Nomi_Noturni
'----------------------------------------------------
Unload UserForm1  ' chiude immag attendi
MsgBox ("Completato...")
End Sub


Le istruzioni modificate o aggiunte sono quelle marcate ###

Prova...

[raimea]

ciao
tutto ok

grazie