Condividi:        

funzione Cerca.vert

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

funzione Cerca.vert

Postdi criscolo67 » 26/07/11 13:37

Salve ragazzi, avrei una richiesta, premetto che ho cinque cartelle excel distinte per Reparti di lavoro, identiche tra loro in formati e formule, con la sola differenza nei nomi dei dipendenti, da queste cartelle prelevo i dati dei singoli nominativi e li riporto in un’altra cartella “chiusura globale” usando la funzione cerca.vert, per intenderci la prima formula che utilizzo è “CERCA.VERT($A1;[“x”.xls]foglio “Y”!$C$8:$AK$72;4;FALSO)”, dove A1 è il dipendente, x la cartella del reparto, y il foglio che contiene i dati che interessano, l’unico inconveniente e che un dipendente può per esigenze cambiare reparto per cui devo ogni volta che ciò avviene variare la formula cambiando la cartella di riferimento.
Mi chiedevo se si potrebbe aggiungere alla stringa suddetta la funzione “Se” cercando autonomamente il nominativo “A1” in tutte le cartelle e una volta trovato riportare il dato della cella “4” . Io ci ho provato ma mi da errore sicuramente ci vuole qualche accorgimento e effettuare il tutto con una macro ma sono un dilettante e non conosco bene i passaggi. Grazie per l’interessamento
;)
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Sponsor
 

Re: funzione Cerca.vert

Postdi Flash30005 » 26/07/11 17:21

Prova questa macro seguendo le indicazioni per l'adattamento ai tuoi dati
Codice: Seleziona tutto
Sub TrovaDip()
Dim VRep(5) As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
Perc = "C:\"
VRep(1) = "Reparto1.xls"
VRep(2) = "Reparto2.xls"
VRep(3) = "Reparto3.xls"
VRep(4) = "Reparto4.xls"
VRep(5) = "Reparto5.xls"
UR = Range("A" & Rows.Count).End(xlUp).Row
For RRG = 1 To UR
Dip = UCase(Range("A" & RRG).Value)
For Cart = 1 To 5
Workbooks.Open Filename:=Perc & VRep(Cart)
Worksheets("Foglio1").Activate
    For RR = 8 To 72
    If UCase(Cells(RR, 3).Value) = Dip Then
    ThisWorkbook.Worksheets("Foglio1").Range("B" & RRG).Value = Cells(RR, 6).Value
    GoTo Esci
    End If
    Next RR
Next Cart
Esci:
Workbooks(VRep(Cart)).Close savechanges:=False
Next RRG
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Prova e fai sapere
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: funzione Cerca.vert

Postdi criscolo67 » 26/07/11 19:12

ciao flash, ho provato a lanciare la tua macro ma nulla mi da errore, sicuramente ho sbagliato a inserire i miei dati non capisco tutti i passaggi ma come ho detto non sono pratico e quindi ci vuole pazienza. allora, ad ogni buon conto cerco di chiarire ciò che mi serve. ogni mese i responsabili di reparto mi inciano le loro chiusure (sono fogli di calcolo racchiusi in una cartella) faccio l'esempio con un solo foglio, si chiama "C8" uguale per ogni reparto con la sola differenza dei nominativi dei dipendenti. tutte le 5 cartelle.xls le inserisco in una cartella sul desktop che chiamerò luglio 2011, al suo interno vi è anche la mia chiamata "chiusura totale.xls" con lo stesso foglio "C8" con l'unica differenza che sul mio ci sono tutti i nominativi dei dipendenti e il mio intento è riportare per ogni dipendente ciò che riportano le celle corrispondenti.
le cartelle si chiamano reparto 1,2,3,4,5.
i fogli all'interno delle cartelle si chiamano C8.
i nominativi si trovano nella colonna C.
ogni reparto ha un massimo di 72 righe bianche e non ove vengono riportati i nominativi
le colonne sono 15 di cui la A riporta nr. ordine, la B la carica rivestita, la C il cognome, la D il nome e dalla e in poi le varie indennità.
spero di essere stato chiaro e scusate l'ignoranza.
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Re: funzione Cerca.vert

Postdi Flash30005 » 26/07/11 19:56

1) non usare il desktop per posizionare cartelle (il desktop è personale e riferito all'utente, cambia da Pc a Pc e da utente a utente) quindi usa una cartella standard ad esempio per i test usa la cartella C:\temp\
2) inserisci la cartella Luglio2011 (evita di lasciare spazio vuoto nei nomi cartelle e file)
3) quindi il percorso sarà:
C:\temp\Luglio2011
4) in questa cartella avrai i file di excel che credo, aver capito, siano Reparto1.xls, Reparto2.xls etc
(elimina lo spazio sul nome del file)

5) Ora in un modulo del File "ChiusuraTotale.xls" inserisci questo codice
e segui le istruzioni in verde

Codice: Seleziona tutto
Sub TrovaDip()
Dim VRep(5) As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
Perc = "C:\temp\Luglio2011\"  '<<<< percorso standard che cambierai dopo aver fatto dei test
VRep(1) = "Reparto1.xls"  '<<<<< nome effettivo dei file
VRep(2) = "Reparto2.xls"
VRep(3) = "Reparto3.xls"
VRep(4) = "Reparto4.xls"
VRep(5) = "Reparto5.xls"
UR = Range("A" & Rows.Count).End(xlUp).Row
For RRG = 1 To UR
Dip = UCase(Range("A" & RRG).Value)
For Cart = 1 To 5
Workbooks.Open Filename:=Perc & VRep(Cart)
Worksheets("C8").Activate      '<<<<< foglio che contiene i dati dei dipendenti
    For RR = 8 To 72
    If UCase(Cells(RR, 3).Value) = Dip Then
    ThisWorkbook.Worksheets("C8").Range("B" & RRG).Value = Cells(RR, 6).Value  'qui ci va il nome del foglio contenuto nel file "ChiusuraTotale.xls" e dove vorresti riportare il dato prelevato dal foglio dipendenti (io ho utilizzato la colonna B) e il prelievo dalla colonna F (così mi risulta dalla tua formula) se diversa cambia il valore 6 (numero colonna in altro numero colonna)
    GoTo Esci
    End If
    Next RR
Next Cart
Esci:
Workbooks(VRep(Cart)).Close savechanges:=False
Next RRG
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Fai sapere se incontri problemi e dove

ciao

EDIT ore 21:20 (rileggi l'intero post): Il foglio CalcoloTotale.xls può essere in qualsiasi parte del disco, non necessariamente in C:\temp...
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: funzione Cerca.vert

Postdi criscolo67 » 27/07/11 10:21

no flash, mi esce il messaggio indice non incluso nell'intervallo e lascia aperte tutte le cartelle di collegamento.
ti invio per farti un'idea una copia (con i nomi sostituiti con numeri) del file C8totale, identico con i C8 dei reparti cona la sola diferenza degli identificativi dei dipendenti in quanto nel totale sono elencati tutti, nella cartella non ho riportato altri fogli con indennità diverse in quanto una volta trovata la soluzione provvederò a copiarla negli altri fogli. grazie per la pazienza


http://www.mediafire.com/?lwjefm4ea48429i
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Re: funzione Cerca.vert

Postdi Flash30005 » 27/07/11 13:28

Rimanevano aperti perché mancava una riga di codice che chiudeva il foglio nel caso non avesse trovato la stringa cercata.
Ho creato il percorso come lo hai tu e inserito 5 file con lo stesso nome che hai impostato nella macro
e ho visto che prelevi il valore della colonna F del file dipendenti e lo inserisci nella colonna C
infatti la macro fa proprio questo
provala
Codice: Seleziona tutto
Sub TrovaDip()
Dim VRep(5) As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
Perc = "C:\chiusure\Luglio2011\"
VRep(1) = "stanziale.xls"
VRep(2) = "volante.xls"
VRep(3) = "cinofili.xls"
VRep(4) = "sq.comando.xls"
VRep(5) = "atpi.xls"
UR = Range("A" & Rows.Count).End(xlUp).Row  '<<<<<< questa variabile conta il numero di righe (piene) nella colonna A
For RRG = 12 To UR  '<<<< scansiona ogni riga del file "Totale" a partire dalla dodicesima
Dip = UCase(Range("A" & RRG).Value)  '<<< preleva la stringa sulla colonna A per ricercarla sui 5 file
For Cart = 1 To 5
Workbooks.Open Filename:=Perc & VRep(Cart)
Worksheets("C8").Activate
    For RR = 8 To 14  '<<<<<<<< cambia questo valore adeguandolo al tuo numero riga
    If UCase(Cells(RR, 3).Value) = Dip Then
    ThisWorkbook.Worksheets("C8totale").Range("C" & RRG).Value = Cells(RR, 6).Value
    GoTo Esci
    End If
    Next RR
    Workbooks(VRep(Cart)).Close savechanges:=False
Next Cart
Esci:
Workbooks(VRep(Cart)).Close savechanges:=False
Next RRG
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Devi solo verificare quanto scritto nei commenti inseriti nella macro

Fai sapere
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: funzione Cerca.vert

Postdi criscolo67 » 27/07/11 16:46

nulla di fatto, non rimangono aperte più le cartelle ma la macro lavora senza trascrivere nulla. poi ho letto ciò che hai scritto io non devo prelevare i dati dalla colonna f e trascriverli nella c, il c8 totale deve solo ricercare i vari nomi nelle cartelle dei reparti e riportare i valori che i responsabili hanno inserito nelle celle di riferimento. es. il sig. Rossi del reparto stanziale ha svluppato le indennita riportate dalla colonna f sino alla z quindi nel c8totale la macro deve cercare il rossi della colonna c nei vari reparti e una volta trovato riportare i valori nelle celle (dalla f alla z). il file che ho postato riporta fedelmente il c8totale e di riflesso tutti gli altri c8 solo che il totale ha 108 nominativi gli altri c8 arrivano a 108 sommati tra loro. saluti
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Re: funzione Cerca.vert

Postdi Flash30005 » 27/07/11 21:48

Io mi sono riferito alla tua formula
criscolo67 ha scritto:“CERCA.VERT($A1;[“x”.xls]foglio “Y”!$C$8:$AK$72;4;FALSO)”,

che cerca vericale nella colonna A del foglio Totali
nel range dei vari fogli in Colonna C (presumo quindi i cognomi) e riporta la cella F (+4 della matrice cerca.verticale)

Non ho un foglio di dati origine quindi dovrò inventarmelo...
proverò a copiare le colonne F:z e riportarle nel foglio totale
Speriamo bene!
...
Aggiungo la macro modificata secondo le ultime specifiche
Codice: Seleziona tutto
Sub TrovaDip()
Dim VRep(5) As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
Perc = "C:\chiusure\Luglio2011\"
VRep(1) = "stanziale.xls"
VRep(2) = "volante.xls"
VRep(3) = "cinofili.xls"
VRep(4) = "sq.comando.xls"
VRep(5) = "atpi.xls"
UR = Range("C" & Rows.Count).End(xlUp).Row
For RRG = 12 To UR
Dip = UCase(Range("C" & RRG).Value)
For Cart = 1 To 5
Workbooks.Open Filename:=Perc & VRep(Cart)
Worksheets("C8").Activate
URC = Range("C" & Rows.Count).End(xlUp).Row
    For RR = 8 To 14
    If UCase(Cells(RR, 3).Value) = Dip Then
    Range(Cells(RR, 6), Cells(RR, 26)).Copy
    Windows("CHIUSURA TOTALE.xls").Activate
    Cells(RRG, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    GoTo Esci
    End If
    Next RR
    Workbooks(VRep(Cart)).Close savechanges:=False
Next Cart
Esci:
Workbooks(VRep(Cart)).Close savechanges:=False
Next RRG
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Ricorda che i fogli da te menzionati dovranno trovarsi in questo percorso
"C:\Chiusure\Luglio2011\"
Noterai che per svolgere questa ricerca verrà impiegato diverso tempo e pensavo che sarebbe molto ridotto se si inserisse reparto in una apposita colonna (del File Totale) in maniera tale da aprire solo quel file (e non tutti e 5 per la ricerca) in caso di insuccesso su quel reparto allora scansionare gli altri file con l'accorgimento di aggiornare il file Totale e quel dipendente al nuovo reparto assegnato
Cosa ne pensi?
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: funzione Cerca.vert

Postdi criscolo67 » 28/07/11 09:37

Ok Flash, sei grande, funziona tutto ma ci mette un botto di tempo circa 5 minuti, tenendo presente che i fogli da aggiornare nella cartella sono diversi non solo il C8 ho paura che non sia per me molto efficace, con le formule che avevo prima in ogni cella dalla f alla z, all'apertura del file mi chiedeva se volessi aggiornare ed era immediato, l'inconveniente era che in ogni formula ero io che davo il percorso del reparto del dipendente e quindi in caso di trasferimento tra reparti dovevo ogni volta aggiornare le formule. detto questo cio che mi proponevi penso si possa fare in quanto il file totale lo posso variare a mio piacimento aggiungendo una altra colonna l'importante non cambiare il formato dalla colonna b alla z. posto nuovamente i file con le formule che avevo in precedenza unitamente ad un file di origine, giusto per meglio capire la situazione. nella colonna b del file di origine ci sono celle vuote in quanto detto foglio è legato ad un altro dati (formato da 20 intervalli distinti per mansione dei dipendenti di quel reparto) ove preleva i nominativi dei dipendenti e questo per ogni reparto. lo stesso vale per il mio foglio c8totale che preleva i nominativi da un foglio dati nella stessa cartella dove vi è anche qui l'elenco distinto per mansioni solo che ci sono tutti i dipendenti dell'azienda (tutti i reparti).
http://www.mediafire.com/?45t0talvns65anl
http://www.mediafire.com/?2189tz2b8xt58xa
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Re: funzione Cerca.vert

Postdi Flash30005 » 28/07/11 10:30

Come promesso ho modificato la macro e inserito il reparto nella colonna AO (che puoi nascondere)

Ti spiego come funziona:
la prima volta che avvierai la macro non essendoci il reparto del dipendente nella colonna AO
la macro impiegherà tutto il tempo per effettuare la scansione dei 5 fogli.
La seconda volta che effettui l'avvio della stessa macro i tempi saranno ridotti in quanto per ogni dipendente aprirà direttamente il file del reparto di appartenenza.
Nel caso in cui un dipendete abbia cambiato reparto la macro, non trovandolo nel file di appartenenza, scansionerà gli altri fogli e aggiorna la colonna AO in corrispondenza di quel dipendente.

Ultima modifica riguarda il percorso che verrà rilevato in automatico
Inserisci il file "Chiusura Totale" nella direcory "C:\Chiusure"
La directory Chiusure conterrà le sottocartelle Luglio2011, Agosto2011 etc
Pertanto cambiando il mese sul file Chiusura Totale nella cella S4 (ora Luglio) o anno nella cella V4 (ora 2011)
Potrai scansionare con lo stesso foglio il mese e l'anno di tuo interesse solo modificando una o ambedue le celle menzionate.

la macro è questa

Codice: Seleziona tutto
Sub TrovaDip4()
Dim VRep(5) As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
'Perc = "C:\chiusure\Luglio2011\"
Perc = Application.ThisWorkbook.Path & "\" & Range("S4").Value & Range("V4").Value & "\"
VRep(1) = "stanziale.xls"
VRep(2) = "volante.xls"
VRep(3) = "cinofili.xls"
VRep(4) = "sq.comando.xls"
VRep(5) = "atpi.xls"
UR = Range("C" & Rows.Count).End(xlUp).Row
For RRG = 12 To UR
Rep = Range("AO" & RRG).Value
If Rep = 0 Then
Trovatutti:
TRov = 0
Dip = UCase(Range("C" & RRG).Value)
For Cart = 1 To 5
Workbooks.Open Filename:=Perc & VRep(Cart)
Worksheets("C8").Activate
    For RR = 8 To 14  '<<<<<<<<< inserisci il numero righe effettive dei fogli dipendenti
    If UCase(Cells(RR, 3).Value) = Dip Then
    Range(Cells(RR, 6), Cells(RR, 26)).Copy
    Windows("CHIUSURA TOTALE.xls").Activate
    Cells(RRG, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("AO" & RRG).Value = VRep(Cart)
    GoTo Esci
    End If
    Next RR
    Workbooks(VRep(Cart)).Close savechanges:=False
Next Cart
Esci:
On Error GoTo error_Msgc
Workbooks(VRep(Cart)).Close savechanges:=False
Else
Dip = UCase(Range("C" & RRG).Value)
TRov = 0
Workbooks.Open Filename:=Perc & Range("AO" & RRG).Value
Worksheets("C8").Activate
    For RR = 8 To 14  '<<<<<<<<< inserisci il numero righe effettive dei fogli dipendenti
    If UCase(Cells(RR, 3).Value) = Dip Then
    TRov = 1
    Range(Cells(RR, 6), Cells(RR, 26)).Copy
    Windows("CHIUSURA TOTALE.xls").Activate
    Cells(RRG, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    GoTo Esci2
    End If
    Next RR
    Workbooks(Rep).Close savechanges:=False
    If TRov = 0 Then GoTo Trovatutti
Esci2:
Workbooks(Rep).Close savechanges:=False
End If
Next RRG
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub

error_Msgc:
Workbooks(Rep).Close savechanges:=False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Dipendente non trovato in nessun Reparto", vbInformation
On Error GoTo 0
End Sub


Fai sapere se i tempi sono più accettabili
(chiaramente dopo la prima scansione)
Penso comunque di trovare una ulteriore soluzione per rendere ancora più veloce l'esecuzione

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: funzione Cerca.vert

Postdi criscolo67 » 28/07/11 13:54

flash, i tempi sono sempre lunghi circa 10 minuti dopo la prima scansione, ma tutto funziona, come ti avevo detto nella cartella i fogli da aggiornare sono tanti per cui lanciando la macro in ogni foglio comporterebbe troppo tempo. vorrei chiederti lasciando perdere eventuali macro ma lavorando sulle formule non si potrebbe risolvere aggiungendo le condizioni?? ho provato a modificare le formule nelle singole(dalla f alla z) celle ma da sempre errore. saluti
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Re: funzione Cerca.vert

Postdi Flash30005 » 28/07/11 14:35

Ormai già stavo lavorando sulla macro che dimezzasse i tempi e quindi la pubblico
poi vediamo come fare per le formule che sinceramente non vedo come possano dare errore con un semplice Cerca.Verticale, avendo però una colonna (come nel mio caso:AO), con il nome del file nel quale applicare la ricerca

Codice: Seleziona tutto
Sub TrovaDip5()
Start = Timer
Dim VRep(5) As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
Perc = Application.ThisWorkbook.Path & "\" & Range("S4").Value & Range("V4").Value & "\"
VRep(1) = "stanziale.xls"
VRep(2) = "volante.xls"
VRep(3) = "cinofili.xls"
VRep(4) = "sq.comando.xls"
VRep(5) = "atpi.xls"
UR1 = Range("C" & Rows.Count).End(xlUp).Row
Dim WB1 As Workbook
Dim WB2 As Workbook

Dim Ws1, Ws2 As Worksheet
Set WB1 = ThisWorkbook
Set Ws1 = WB1.Worksheets("C8totale")

For RR1 = 12 To UR1
    If RR1 = 47 Then GoTo Fine
    Rep = Ws1.Range("AO" & RR1).Value
    If Rep = "" Then
    Trov = 0
Trovatutti:

        For Cart = 1 To 5
            Workbooks.Open Filename:=Perc & VRep(Cart)
            Set WB2 = Workbooks(VRep(Cart))
            Set Ws2 = WB2.Worksheets("C8")
            UR2 = Ws2.Range("C" & Rows.Count).End(xlUp).Row
            WB1.Activate
            On Error Resume Next
            RR2 = 1
            RR2 = Application.WorksheetFunction.Match(Ws1.Range("C" & RR1), Ws2.Range("C1:C" & UR2), 0)
            If RR2 = 1 Then GoTo Esci
            Ws2.Range("F" & RR2 & ":Z" & RR2).Copy Destination:=Ws1.Range("F" & RR1)
            Ws1.Range("AO" & RR1).Value = VRep(Cart)
            Trov = 1
            GoTo Salta
Esci:
            On Error GoTo 0
            WB2.Close savechanges:=False
        Next Cart
Salta:
        On Error GoTo error_Msgc
        WB2.Close savechanges:=False
    Else
        Workbooks.Open Filename:=Perc & Rep
        Set WB2 = Workbooks(Rep)
        Set Ws2 = WB2.Worksheets("C8")
        UR2 = Ws2.Range("C" & Rows.Count).End(xlUp).Row
        WB1.Activate
        On Error Resume Next
        RR2 = 1
        RR2 = Application.WorksheetFunction.Match(Ws1.Range("C" & RR1), Ws2.Range("C1:C" & UR2), 0)
        If RR2 = 1 Then GoTo Trovatutti
        Ws2.Range("F" & RR2 & ":Z" & RR2).Copy Destination:=Ws1.Range("F" & RR1)
        Trov = 1
        On Error GoTo 0
        WB2.Close savechanges:=False
    End If
If Trov = 0 Then GoTo error_Msgc
Next RR1
Fine:
Call Formatta
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Tempo = Int(Timer - Start)
MsgBox Tempo
Exit Sub

error_Msgc:
    'Workbooks(Rep).Close savechanges:=False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Dipendente " & Range("C" & RR1).Value & " non trovato in nessun Reparto", vbInformation
On Error GoTo 0

End Sub


Sub Formatta()

    Range("F12:Z119").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("C4").Select
End Sub


Prova e fai sapere
Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: funzione Cerca.vert

Postdi criscolo67 » 28/07/11 15:04

cmq ho provato e riprovato, ma purtroppo quando trova un nome non esistente non esce il messaggio, ma blocca tutta l'esecuzione e mi evidenzia l'errore nella macro che corrisponde all'istruzione
"Workbooks(Rep).Close savechanges:=False"
non riesco a capire il perchè...in uanto se dopo il debug mi posiziono con il cursore su (rep) mi esce scritto cart=6 e dà l'errore indice non trovato...secondo me l'errore sta li perchè le cartelle sono 5 e quindi è giusto che non trova l'indice 6...tu che dici? grazie
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Re: funzione Cerca.vert

Postdi criscolo67 » 28/07/11 16:05

ho risolto il problema del messaggio ma per il resto uguale il tempo è interminabile. ciao
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Re: funzione Cerca.vert

Postdi Flash30005 » 28/07/11 16:25

Se è solo per quello è una sciocchezza ma mi devi dire in quale riga dà quell'errore perché il codice da te postato si trova in più punti della macro
quindi metti anche i riferimenti o meglio l'immagine (screenshot) del debug con evinziata la riga in giallo.

Ho fatto diverse prove
1) togliendo il reparto in AO ad un dipendente e la macro lo va a cercare su tutti i fogli
2) eliminando un dipendente nei fogli dipendenti e la macro avvisa che il dipendente X non esiste in nessun File
3) mettendo un numero di dipendente maggiore di qualsiasi dipendente esistente e si comporta come al punto 2

ti invio questi file necessari per i test

Fai sapere se incontri lo stesso problema
ciao


EDIT: Stavo preparando i file per l'invio e solo dopo ho visto che avevi già risposto
ma vorrei sapere
se
1) i file sono più di 5
2) quante righe hai in ogni foglio dipendenti
Il totale credo sia come lo hai inviato 119 righe
Non dovrebbe impiegare tutto il tempo che dici perché con 35 dipendenti impiego 10 secondi con CPU vecchia generazione e con il reparto assegnato sulla colonna AO
Dovresti compilare un foglio completo (luglio2011) in 30 secondi circa
e anche meno visto che non ho un PC moderno
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: funzione Cerca.vert

Postdi Flash30005 » 28/07/11 18:17

(Se non lo hai ancora fatto leggi il post precedente)

Se vuoi realizzare il foglio totali con le formule avendo il file nella colonna AO (come fornisce la macro precedente)

Selezioni la cella F12 nella quale inserirai questa formula
Codice: Seleziona tutto
=CERCA.VERT($C12;INDIRETTO($AO12&"!C:Z");RIF.COLONNA()-2;0)

Selezioni la cella F12 e la trascini verso destra fino alla colonna Z
poi selezioni l'inteo range F12:Z12
e trascini verso il basso fino dove occorre

ciao

NB. avrai sempre Rif se i fogli origine sono chiusi
quindi li dovrai aprirli tutti
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: funzione Cerca.vert

Postdi criscolo67 » 28/07/11 18:41

ho provato i tuoi file effettivamente è veloce, ma se la macro la lancio con le mie cartelle il processo dura 15 minuti precisi, ( ho usato la tua macro inserendo i 119 nominativi e la mia cartella Luglio 2011) penso sia dovuto dal fatto che ogni cartella dei reparti contenenti il foglio c8 è grande 10 mega.
rispondendo alle tue richieste ti posso dire che ogni cartella (atpi,volante ecc) contiene 75 fogli tra cui il c8; le righe nei fogli (c8) dipendenti sono 72 se comprendo la riga che riporta il totale; mentre il c8totale ne ha 120 compresa la riga dei totali. Mi sorge un dubbio nell'eventualità di incremento del personale o diminuzione le righe potranno diventare nel c8totale meno o più di 119 mentre nel c8 dipendenti sarà sempre 71.
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Re: funzione Cerca.vert

Postdi Flash30005 » 28/07/11 19:43

Ora è tutto comprensibile
75 fogli magari pieni di formule (visto che mi sembra aver capito non usi di frequente le macro)
arrivi certamente a 10 Mb e oltre
proprio questo è uno dei motivi (diversi fogli e aree piene) preferisco la macro rispetto alla formula che può essere più o meno lunga ma sicuramente ha più caratteri di un semplice valore numerico.
Alla luce di questa tua disposizione di dati penso ci sia una sola cosa da fare...

una procedura con macro la si potrebbe realizzare con queste fasi:
1) creare una macro che apre il singolo file-reparto
2) copiare il foglio C8 in una nuova cartella (incolla speciale solo valori),
3) chiudere il File origine (da 10 Mb)
4) salvare con nome noto questo file che ha un solo Foglio "C8",
5) attivare l'ultima macro realizzata per riportare sul File Totale i dati
6) chiudere il file ed eliminarlo (oppure lasciarlo ma eliminarlo prima che si verifichi il punto 4).

Oppure usare le formule come ti ho postato prima, ma questa soluzione ti costringe ad aprire tutti i file,
File che possono essere aperti automaticamente tramite semplice codice VBA all'apertura del file Totale

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: funzione Cerca.vert

Postdi criscolo67 » 28/07/11 21:34

ok ora provo tutte le soluzioni. grazie per la pazienza
criscolo67
Utente Junior
 
Post: 96
Iscritto il: 13/05/11 13:50

Re: funzione Cerca.vert

Postdi Anthony47 » 29/07/11 01:01

Ho seguito distrattamente la discussione e mi viene la domanda: ma aprire (uno dopo l' altro) i file di reparto, copiare le righe compilate del foglio C8, accodarle sul modello C8Totale da B12 in giu', chiudere il file di reparto, passare al successivo? Magari aggiungendo in una colonna il nome file da cui sono prelevati...

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

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "funzione Cerca.vert":


Chi c’è in linea

Visitano il forum: Nessuno e 30 ospiti