Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

cercare e prelevare celle unite

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

cercare e prelevare celle unite

Postdi raimea » 01/07/20 06:59

ciao
vorrei riuscire a compilare l elenco
dei tecnici in reperibilita' nel mese indicato.

avviso subito che le celle da andare a cercare e prelevare
PURTROPPO sono state config con unisci cella !!!
quindi non so' se sara' possibile realizzare mia richiesta.

vorrei compilare il fgl reperibilita_mese

cercare nel fgl indicato in D4
( perche' poi il file originale e' composto da molti fogli)
partendo dalla data indicata in E5

prelevare il nome del tecnico
che ha la scritta >>> Reperibile
oppure >>> RINFORZO

e riuscire a prelevare e inserire la scritta in fgl reperibilita_mese
sotto alla data di inizio reperibilita'

so' che dovendo lavorare su "unisci celle" e' molto complicato.

spero di essermi spigato

vi allego un file

https://www.dropbox.com/s/5fgjvvna1s5646c/reperibilita_mese.rar?dl=0

grazie
http://www.lelugarine.eu
S.O. Seven7, Excell 2010
Avatar utente
raimea
Utente Senior
 
Post: 1233
Iscritto il: 11/02/10 07:33
Località: lago

Sponsor
 

Re: cercare e prelevare celle unite

Postdi Anthony47 » 01/07/20 14:47

Probabilmente funzionera' questa:
Codice: Seleziona tutto
Sub CercaRE()
Dim fV As Range, I As Long, istAdr As String
Dim lFor As String, lDate As Date, lsDate As Date, lastD As Long
Dim SC As Range, ccDate As Date, myX, myY, myZ0
'
Sheets("reperibilita_mese").Select
lDate = Range("D3").Value
lsDate = Application.WorksheetFunction.EDate(lDate, 1) - 1

myZ0 = Application.Match(CLng(lDate), Sheets(Range("D4").Value).Range("A2").Resize(1, 370), False)
If IsError(myZ0) Then
    MsgBox ("Fuori campo date: " & Format(lDate, "dd-mmm-yyyy"))
    Exit Sub
End If
If myZ0 > 5 Then myZ0 = myZ0 - 5 Else myZ0 = 1
lastD = Worksheets(Range("D4").Value).Cells(Rows.Count, "D").End(xlUp).Row + 3
Range("E6").Resize(200, 35).MergeCells = False
Range("AL7").Copy Range("E6").Resize(100, 35)
'
For I = 1 To 2
    If I = 1 Then lFor = "Reperibile" Else lFor = "RINFORZO"
    With Worksheets(Range("D4").Value).Cells(2, myZ0).Resize(lastD, 50)
        Set fV = .Find(lFor, LookIn:=xlValues)
        If Not fV Is Nothing Then
            istAdr = fV.Address
            Do
                Debug.Print fV.Address, lFor
                For Each SC In fV.MergeArea
                    ccDate = SC.Offset(-SC.Row + 2, 0).Value
                    If ccDate >= lDate And ccDate <= lsDate Then
                        myX = Application.Match(CLng(ccDate), Range("A5:AM5"), False)
                        myY = Application.Match(SC.Offset(0, 4 - SC.Column).MergeArea.Cells(1, 1).Value, Range("D1:D200"), False)
                        If Not IsError(myX) And Not IsError(myY) Then
                            Cells(myY, myX).Value = Left(lFor, 2)
                            Cells(myY, myX).Interior.Color = RGB(255, 255, 0)
                        End If
                    End If
                Next SC
                Set fV = .FindNext(fV)
'                If fV.Address = istAdr Then Exit Do
            Loop While Not fV Is Nothing And fV.Address <> istAdr
        End If
    End With
Next I
MsgBox ("Completato...")
End Sub

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17005
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cercare e prelevare celle unite

Postdi raimea » 01/07/20 16:32

ciao

la macro funziona
:-? :-? :-? :-?

MA ho dimenticato io di specificare un passaggio

l elenco dei nomi nella colonna D6
deve essere aggiornato in relazione al foglio specificato in D4

quindi vanno cancellati i nomi presenti
e sostituiti con quelli del foglio indicato in D4

possibilmente i nomi di solo quelli che faranno reperibilita
( ma se non possibile anche tutti i nomi ).

Poi andare a prelevare la scritta >>> Reperibile
oppure >>> RINFORZO

pardon !

ringrazio
http://www.lelugarine.eu
S.O. Seven7, Excell 2010
Avatar utente
raimea
Utente Senior
 
Post: 1233
Iscritto il: 11/02/10 07:33
Località: lago

Re: cercare e prelevare celle unite

Postdi Anthony47 » 01/07/20 16:52

Mi sembrava strano, che i nominativi fossero gia' presenti... Preferisci solo i nominativi con servizi da evidenziare o tutti i nominativi presenti nel foglio richiamato?

Poi andare a prelevare la scritta >>> Reperibile
oppure >>> RINFORZO
Questa non la capisco :-?
Avatar utente
Anthony47
Moderatore
 
Post: 17005
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cercare e prelevare celle unite

Postdi raimea » 01/07/20 16:55

ciao

Mi sembrava strano, che i nominativi fossero gia' presenti... Preferisci solo i nominativi con servizi da evidenziare o tutti i nominativi presenti nel foglio richiamato?


preferirei solo i nominativi con servizi da evidenziare importare

grazie
http://www.lelugarine.eu
S.O. Seven7, Excell 2010
Avatar utente
raimea
Utente Senior
 
Post: 1233
Iscritto il: 11/02/10 07:33
Località: lago

Re: cercare e prelevare celle unite

Postdi Anthony47 » 01/07/20 20:31

Le modifiche sono poche, ma preferisco ripubblicare l'intero codice:
Codice: Seleziona tutto
Sub CercaRE()
Dim fV As Range, I As Long, istAdr As String
Dim lFor As String, lDate As Date, lsDate As Date, lastD As Long
Dim SC As Range, ccDate As Date, myX, myY, myZ0
'
Sheets("reperibilita_mese").Select
lDate = Range("D3").Value
lsDate = Application.WorksheetFunction.EDate(lDate, 1) - 1

myZ0 = Application.Match(CLng(lDate), Sheets(Range("D4").Value).Range("A2").Resize(1, 370), False)
If IsError(myZ0) Then
    MsgBox ("Fuori campo date: " & Format(lDate, "dd-mmm-yyyy"))
    Exit Sub
End If
If myZ0 > 5 Then myZ0 = myZ0 - 5 Else myZ0 = 1
lastD = Worksheets(Range("D4").Value).Cells(Rows.Count, "D").End(xlUp).Row + 3
Range("D6").Resize(200, 36).ClearContents
Range("E6").Resize(200, 35).MergeCells = False
Range("AL7").Copy Range("E6").Resize(100, 35)
'
For I = 1 To 2
    If I = 1 Then lFor = "Reperibile" Else lFor = "RINFORZO"
    With Worksheets(Range("D4").Value).Cells(2, myZ0).Resize(lastD, 50)
        Set fV = .Find(lFor, LookIn:=xlValues)
        If Not fV Is Nothing Then
            istAdr = fV.Address
            Do
                Debug.Print fV.Address, lFor
                For Each SC In fV.MergeArea
                    ccDate = SC.Offset(-SC.Row + 2, 0).Value
                    If ccDate >= lDate And ccDate <= lsDate Then
                        myX = Application.Match(CLng(ccDate), Range("A5:AM5"), False)
                        myY = Application.Match(SC.Offset(0, 4 - SC.Column).MergeArea.Cells(1, 1).Value, Range("D1:D200"), False)
                        If IsError(myY) Then
                            myY = Cells(Rows.Count, "D").End(xlUp).Row + 1
                            Cells(myY, "D").Value = SC.Offset(0, 4 - SC.Column).MergeArea.Cells(1, 1).Value
                        End If
                        If Not IsError(myX) And Not IsError(myY) Then
                            Cells(myY, myX).Value = Left(lFor, 2)
                            Cells(myY, myX).Interior.Color = RGB(255, 255, 0)
                        End If
                    End If
                Next SC
                Set fV = .FindNext(fV)
'                If fV.Address = istAdr Then Exit Do
            Loop While Not fV Is Nothing And fV.Address <> istAdr
        End If
    End With
Next I
MsgBox ("Completato...")
End Sub

Prova...
Avatar utente
Anthony47
Moderatore
 
Post: 17005
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: cercare e prelevare celle unite

Postdi raimea » 01/07/20 20:52

ciao
OTTIMO !

come sempre ,

e grazie mille

ciao
http://www.lelugarine.eu
S.O. Seven7, Excell 2010
Avatar utente
raimea
Utente Senior
 
Post: 1233
Iscritto il: 11/02/10 07:33
Località: lago

Re: cercare e prelevare celle unite

Postdi Flash30005 » 05/07/20 22:11

Ciao Raimea
spero di tornare presto attivo
ma ad ogni accesso ho sempre notato la "fluidità" e correttezza da parte degli utenti e soluzioni ottimali anche da utenti più "specializzati" che hanno reso il "lavoro", del moderatore, meno impegnativo.
Un Forum è composto da un innumerevole numero di utenti che chiedono e anche da altri che possono dare una soluzione senza alcun intervento del moderatore perché il Forum è di tutti.
Il moderatore ha funzioni, appunto, di moderare, (spam, post illeciti, illegali e tanto altro, poi, si sa se nessuno fornisce una soluzione il moderatore deve intervenire.
Per i neofiti: i Moderatori non hanno alcun compenso per essere qui, lo fanno solo per passione.
A presto!
Flash
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8499
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: cercare e prelevare celle unite

Postdi raimea » 06/07/20 06:45

ciao Flash30005
felice di ri-leggerti

per me, il forum pc-facile
e' una dei pochi con interventi sempre correti , mirati e coerenti con la sezione dell' argomento
e PRIVO di inutili , infinite.. discussioni polemiche.

io dal forum in anni , ho ottenuto MOLTO e di tutto,
ma in particolare sono almeno riuscito a gestire i codici VBA,
non sono in grado di crearne complessi da zero ma modificarli con vari "sfronzoli" si.
e questo solo grazie a pc-facile.

a presto Flash
ciao
http://www.lelugarine.eu
S.O. Seven7, Excell 2010
Avatar utente
raimea
Utente Senior
 
Post: 1233
Iscritto il: 11/02/10 07:33
Località: lago


Torna a Applicazioni Office Windows


Topic correlati a "cercare e prelevare celle unite":


Chi c’è in linea

Visitano il forum: Nessuno e 17 ospiti