Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Estrapolare dati

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

Re: Estrapolare dati

Postdi diego.brero » 18/10/12 13:55

Gli avevo già prospettato questa soluzione e quella che ti ho inviato (per questo ho tardato nella risposta precedente),
ma questa mattina mi ha detto che prefisce quella con una sola, data perchè è più facile da individuare quali operai in un determinato giorno erano presenti in quel cantiere e possibilmente fare un totale ore sulle colonne e sulle righe.

ciao
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Sponsor
 

Re: Estrapolare dati

Postdi Flash30005 » 18/10/12 15:03

Allora aggiungi alla cartella il foglio3 (se non è presente)
Nel foglio3 definisci un elenco dinamico così:
dal Menu Inserisci -> Nome -> Definisci
nel box in alto scrivi "ElCantieri3" (senza virgolette)
e Riferito a incolla questa formula
Codice: Seleziona tutto
=INDIRETTO("Foglio3!A1:A"&CONTA.VALORI(Foglio3!$A:$A))


Ti posizioni in B1 e
dal Menu Dati -> Convalida
Consenti seleziona Elenco
Origine scrivi "=ElCantieri3" (senza virgolette)

Colora di verde la cella B1 (come promemoria)

Ora in un modulo incolla queste due macro
Codice: Seleziona tutto
Sub CompilaF3()
Application.EnableEvents = False
Application.ScreenUpdating = False
Set Ws1 = Worksheets("Foglio1")
Set ws2 = Worksheets("Foglio3")
    Ws1.Columns("B:W").Copy Destination:=ws2.Columns("C:C")
    Ws1.Range("A2:A500").Copy Destination:=ws2.Range("B2")
    UR2 = ws2.Cells(Rows.Count, 2).End(xlUp).Row
    Rows(UR2).Delete
    For CCC = 3 To 24 Step 2
        For RRC = UR2 To 3 Step -1
            If ws2.Cells(RRC, CCC).Value <> ws2.[B1] Then
            ws2.Cells(RRC, CCC).ClearContents
            ws2.Cells(RRC, CCC + 1).ClearContents
            End If
        Next RRC
Next CCC
For RR2 = UR2 To 3 Step -1
    MyRes = Evaluate("=SUM(Foglio3!C" & RR2 & ":X" & RR2 & ")")
    If MyRes = 0 Then Range("B" & RR2 & ":X" & RR2).Delete 'Shift:=xlUp Rows(RR2).Delete
Next RR2
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub AggiornaElCant()
Set Ws1 = Worksheets("Foglio1")
Set ws2 = Worksheets("Foglio3")
UC1 = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
UR1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Application.EnableEvents = False
ws2.Range("A1:A1000").Clear
For CC1 = 2 To UC1 Step 2

    For RR1 = 3 To UR1
    Cantiere1 = Ws1.Cells(RR1, CC1).Value
        UR2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        For RR2 = 1 To UR2
            If ws2.Range("A" & RR2).Value = Cantiere1 Then GoTo SaltaRR1:
        Next RR2
        ws2.Range("A" & UR2).Value = Cantiere1
SaltaRR1:
    Next RR1
Next CC1
  Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Application.EnableEvents = True
End Sub

Vai nel vba del foglio3 e incolli questo codice
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$1" Then Exit Sub
CompilaF3
End Sub

Torni nel foglio
Dal Menu Strumenti -> Macro -> Macro selezioni la macro AggiornaElCantieri (la devi solo selezionare)
e nelle Opzioni della finestra inserisci una "m" (senza virgolette) dopo il CTRL
Premi Ok e chiudi
Ora con Ctrl+m si avvierà la macro che aggiorna la colonna A (che potrai nascondere)

Non appena selezionerai un numero (cantiere) in B1 avrai il tuo prospetto ;)

In caso di difficoltà puoi prelevare questo file
con ambedue le soluzioni
se il foglio2 non lo vorrai utilizzare lo puoi eliminare e userai solo il foglio3

ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Estrapolare dati

Postdi diego.brero » 19/10/12 11:26

Grazie mille dell'aiuto, funziona tutto ok

ciao :lol: :lol: :lol:
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Re: Estrapolare dati

Postdi diego.brero » 23/10/12 16:58

Ciao Flash,
dato che l'appetito vien mangiando, vorrei creare una scheda CANTIERE, dove in base al cantiere e da una certa data ad un'altra, copio solo gli operai che hanno lavorato in quel cantiere, in questo modo posso avere i costi degli operai ai quali poi aggiungo i costi generali e specifici del cantiere. Ti dico vorrei creare perchè creerei un file per ogni cantiere. Mi puoi ancora aiutare?
Ciao e grazie
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Re: Estrapolare dati

Postdi Flash30005 » 23/10/12 22:36

Ok
Dati partenza?
E come o cosa vorresti ottenere?

Ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Estrapolare dati

Postdi diego.brero » 24/10/12 06:26

Ciao Flash, ti ho allegato 2 file
il primo "Cartel1" è quello che vorrei creare, mentre il 2° è il file che mi hai già aiutato a modificare.
TabCantiere = Foglio 3
mentre OreCantiere non l'ho più modificato

In Cartel1, ho inserito alcuni dati e nelle celle evidenziate, ho provato a spiegarti quello che vorrei fare,
spero sia tutto chiaro.

ciao e grazie ancora

http://www.filedropper.com/cartel1
http://www.filedropper.com/costioperaiimpiegati2012
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Re: Estrapolare dati

Postdi Flash30005 » 24/10/12 08:34

Ma non avevi detto che doveva essere prevista una data inizio e data fine di ricerca?
in quale cella/e di cartel1 vanno inserite? (non vorrei utilizzare un range dove prevedi altri inserimenti dati)

Inoltre il file Cartel1 avrà un foglio per cantiere oppure vorresti un file per ogni cantiere?

ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Estrapolare dati

Postdi Flash30005 » 24/10/12 11:14

Visto che non accenni a nulla ho fatto a modo mio
In O2 di Cartel1 Foglio1 inserisci il Numero cantiere
Unisci le celle P2:Q2 e inserisci la data inizio (ricerca)
Unisci le celle S2:T2 e inserisci la data fine (ricerca)
In un modulo di questo file inserisci questa macro che attiverai con Ctrl+m (opzioni della macro)

Codice: Seleziona tutto
Sub CompilaScCant()
NomeFileCant = ThisWorkbook.Name
Perc = ThisWorkbook.Path & "\"
Anno = 2012
NFile = "Costi Operai Impiegati " & Anno & ".xls"
NomeFCant = ActiveSheet.Name
Set Ws1 = Worksheets("Foglio1")
DataIni = Ws1.Range("P2").Value
DataFine = Ws1.Range("S2").Value
Cantiere = Ws1.Range("O2").Value
    Ws1.Range("A5:M1000").ClearContents
    Ws1.Range("C4:H4").ClearContents
    Ws1.Range("A4").FormulaR1C1 = "GG "
    Ws1.Range("B4").FormulaR1C1 = "Data"
    Workbooks.Open Filename:=Perc & NFile
    Set Ws2 = Worksheets("Ore")
    Ws2.Activate
    UR2 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
    UC2 = Ws2.Cells(6, Columns.Count).End(xlToLeft).Column

    For RR2 = 7 To UR2
        If Ws2.Range("B" & RR2) >= DataIni And Ws2.Range("B" & RR2) <= DataFine Then
            For CC2 = 3 To UC2 Step 2
                If Ws2.Cells(RR2, CC2).Value = Cantiere Then
                    Operaio = Ws2.Cells(5, CC2).Value
                    NumO = Ws2.Cells(RR2, CC2 + 1).Value
                    DataC = Ws2.Cells(RR2, 2).Value
                    UC1 = Ws1.Range("A4").CurrentRegion.Columns.Count + 1
                    ColO = UC1
                    For CC1 = 3 To UC1
                        If Ws1.Cells(4, CC1).Value = Operaio Then
                            UR1 = Ws1.Cells(Rows.Count, UC1).End(xlUp).Row + 1
                            Ws1.Cells(UR1, UC1).Value = Operaio
                            ColO = CC1
                            GoTo saltaCC1
                        End If
                    Next CC1
                    Ws1.Cells(4, UC1).Value = Operaio
saltaCC1:
                URS = Ws1.Cells(Rows.Count, 2).End(xlUp).Row + 1
                For RRS = 5 To URS

                If Ws1.Cells(RRS, 2).Value = DataC Then
                    Ws1.Cells(RRS, ColO).Value = NumO
                GoTo saltaRRS
                End If

                Next RRS
                Ws1.Cells(URS, 2).Value = DataC
                Ws1.Cells(URS, ColO).Value = NumO
                Ws1.Range("B" & URS).NumberFormat = "[$-410]d-mmm;@"
                Ws1.Range("A" & URS).FormulaR1C1 = "=RC[1]"
                Ws1.Range("A" & URS).NumberFormat = "ddd"
                Ws1.Range("A" & URS).HorizontalAlignment = xlLeft
                End If
saltaRRS:
            Next CC2
        End If
    Next RR2
    Workbooks(NFile).Close savechanges:=False
URS = Ws1.Cells(Rows.Count, 2).End(xlUp).Row + 2
Ws1.Range("A" & URS).Value = "Tot ore lavorate"
Ws1.Range("A" & URS + 1).Value = "Costo Orario"
Ws1.Range("A" & URS + 2).Value = "Tot Costo"
UC1 = Ws1.Range("A4").CurrentRegion.Columns.Count
For CC1 = 3 To UC1
Ws1.Cells(URS, CC1).FormulaR1C1 = "=SUM(R[-" & URS - 3 & "]C:R[-2]C)"
Next CC1
End Sub


Questo file e il file "Costi Operai Impiegati 2012.xls" devono essere nella stessa directory
(altrimenti cambia il percorso nella macro)


ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Estrapolare dati

Postdi diego.brero » 24/10/12 12:42

Scusa ma sono solo arrivato ora, controllo e ti dico
ciao
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Re: Estrapolare dati

Postdi diego.brero » 24/10/12 13:15

Ho inserito la macro e l'ho attivata con un pulsante, ma quando la lancio vedo che apre il foglio ORE, ma importa solo quello che ti ho inserito qui sotto; entrambi i file sono sulla stessa cartella.

GG Data

Tot ore lavorate
Costo Orario
Tot Costo


Questa mattina non sono riuscito a risponderti perchè ero fuori in cantiere, ma volevo chiederti se in Cartel1 possiamo aprire un foglio per ogni mese in cui si lavora (per conrollare eventuali Stati di Avanzamento Lavoro mensili), quindi al massimo 12 e uno rieilogativo finale.

Ciao
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Re: Estrapolare dati

Postdi diego.brero » 24/10/12 23:50

Ok funziona, avevo inserito la data finale in r2 anzichè s2

ciao
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Re: Estrapolare dati

Postdi Flash30005 » 26/10/12 09:25

diego.brero ha scritto:dato che l'appetito vien mangiando, vorrei

diego.brero ha scritto:...chiederti se in Cartel1 possiamo aprire un foglio per ogni mese in cui si lavora (per conrollare eventuali Stati di Avanzamento Lavoro mensili), quindi al massimo 12 e uno rieilogativo finale.



Tieni presente che così potresti "scoppiare" ovvero scoppiamo in due :D

Bisognerebbe sempre sapere quanto mangiare e cosa mangiare ovvero la meta da raggiungere altrimenti non finiamo più

Comunque in una cartella di lavoro inserisci 12 fogli
ognuno denominato con il nome del mese di tre caratteri (Gen, Feb, Mar, etc)
In un modulo inserisci questa macro
Codice: Seleziona tutto
Sub CompilaScCant()
NomeFileCant = ThisWorkbook.Name
Perc = ThisWorkbook.Path & "\"
Anno = 2012
NFile = "Costi Operai Impiegati " & Anno & ".xls"
NomeFCant = ActiveSheet.Name
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set Ws1 = Worksheets(NomeFCant)
Select Case UCase(NomeFCant)
Case "GEN"
MM = 1
GG = 31
Case "FEB"
MM = 2
GG = 29
Case "MAR"
MM = 3
GG = 31
Case "APR"
MM = 4
GG = 30
Case "MAG"
MM = 5
GG = 31
Case "GIU"
MM = 6
GG = 30
Case "LUG"
MM = 7
GG = 31
Case "AGO"
MM = 8
GG = 31
Case "SET"
MM = 9
GG = 30
Case "OTT"
MM = 10
GG = 31
Case "NOV"
MM = 11
GG = 30
Case "DIC"
MM = 12
GG = 31
End Select
DataIni = DateSerial(Year(Date), MM, 1)
DataFine = DateSerial(Year(Date), MM, GG)

 Ws1.Range("P2").Value = DataIni
Ws1.Range("S2").Value = DataFine
Inizio:
MioCant = Application.InputBox("Cantiere")
If MioCant = "" Then
MsgBox "Digitare un Numero Cantiere"
GoTo Inizio
End If
MioCant = Val(MioCant)
If IsNumeric(MioCant) Then

If MioCant = 0 Then
MsgBox "Zero non è un Numero Cantiere - Digitare un Numero Cantiere <> da 0"
GoTo Inizio
End If
Ws1.Range("O2").Value = MioCant
Cantiere = MioCant
  Set MioCant = Nothing
    Ws1.Range("A5:M1000").ClearContents
    Ws1.Range("C4:H4").ClearContents
    Ws1.Range("A4").FormulaR1C1 = "GG "
    Ws1.Range("B4").FormulaR1C1 = "Data"
    Workbooks.Open Filename:=Perc & NFile
    Set Ws2 = Worksheets("Ore")
    Ws2.Activate
    UR2 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
    UC2 = Ws2.Cells(6, Columns.Count).End(xlToLeft).Column

    For RR2 = 7 To UR2
        If Ws2.Range("B" & RR2) > DataFine Then GoTo esci
        If Ws2.Range("B" & RR2) >= DataIni And Ws2.Range("B" & RR2) <= DataFine Then
       
        Workbooks(NomeFileCant).Activate
            For CC2 = 3 To UC2 Step 2
                If Ws2.Cells(RR2, CC2).Value = Cantiere Then
                    Operaio = Ws2.Cells(5, CC2).Value
                    NumO = Ws2.Cells(RR2, CC2 + 1).Value
                    DataC = Ws2.Cells(RR2, 2).Value
                    UC1 = Ws1.Range("A4").CurrentRegion.Columns.Count + 1
                    ColO = UC1
                    For CC1 = 3 To UC1
                        If Ws1.Cells(4, CC1).Value = Operaio Then
                            UR1 = Ws1.Cells(Rows.Count, CC1).End(xlUp).Row + 1
                            Ws1.Cells(UR1, CC1).Value = NumO
                            ColO = CC1
                            GoTo saltaCC1
                        End If
                    Next CC1
                    Ws1.Cells(4, UC1).Value = Operaio
saltaCC1:
                URS = Ws1.Cells(Rows.Count, 2).End(xlUp).Row + 1
                For RRS = 5 To URS

                If Ws1.Cells(RRS, 2).Value = DataC Then
                    Ws1.Cells(RRS, ColO).Value = NumO
                GoTo saltaRRS
                End If

                Next RRS
                Ws1.Cells(URS, 2).Value = DataC
                Ws1.Cells(URS, ColO).Value = NumO
                Ws1.Range("B" & URS).NumberFormat = "[$-410]d-mmm;@"
                Ws1.Range("A" & URS).FormulaR1C1 = "=RC[1]"
                Ws1.Range("A" & URS).NumberFormat = "ddd"
                Ws1.Range("A" & URS).HorizontalAlignment = xlLeft
                End If
saltaRRS:
            Next CC2


        End If
    Next RR2
esci:
    Workbooks(NFile).Close savechanges:=False
    URS = Ws1.Cells(Rows.Count, 2).End(xlUp).Row + 2
Ws1.Range("A" & URS).Value = "Tot ore lavorate"
Ws1.Range("A" & URS + 1).Value = "Costo Orario"
Ws1.Range("A" & URS + 2).Value = "Tot Costo"
UC1 = Ws1.Range("A4").CurrentRegion.Columns.Count
For CC1 = 3 To UC1
Ws1.Cells(URS, CC1).FormulaR1C1 = "=SUM(R[-" & URS - 3 & "]C:R[-2]C)"
Next CC1
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Chiudi il vba e da qualsiasi foglio premi Ctrl+m (opzioni di avvio macro con tasti scelta rapida)

Secondo me occorrerebbe una memoria di ferro per ricordare quale cantiere ha lavorato in quel determinato mese
(io avrei fatto diversamente...)

Fai sapere

ciao

P.s. Non saprei come vorresti il foglio riepilogo finale
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Estrapolare dati

Postdi diego.brero » 26/10/12 20:40

Ciao, grazie per l'aiuto e soprattutto per la sopportazione :oops: ,
la mia "idea" era quella di creare 1 File per ogni cantiere,
dove foglio1 potrebbe essere tranquillamente quello che mi hai creato precedentemente,
mentre vorrei creare nuovi fogli solo per i mesi nei quali ho lavorato in quel cantiere,
così facendo a fine mese quando ho inserito le ore, apro il file del cantiere e mi ritrovo un
riepilogo nel foglio1 e un dettaglio per i vari mese.
Essendo però nuovo accetto volentieri un tuo consiglio.

Ciao
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Re: Estrapolare dati

Postdi diego.brero » 26/10/12 22:02

Scusa ma avendo un pò di tempo, questa sera ho provato ad immaginare una scheda cantiere che potrebbe funzionare,
te la allego e vorrei chiederti se è fattibile e se secondo te potrebbe funzionare.

http://www.filedropper.com/cantieri

Ciao
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Re: Estrapolare dati

Postdi Flash30005 » 26/10/12 22:16

:roll:
Io direi, invece, creare un file che contiene tutti i cantieri magari uno per foglio (fogli omogenei)
il nome foglio avrà il nome del cantiere (cioè un numero)
in ogni foglio inserirai i dati cantiere
ma questo solo tu sai quali dati o dove li inserisci inoltre dove vorrai riaverli quando richiamati.

Partendo dall'esigenza iniziale, invece, avevo ideato una cosa del genere
Come dicevo nel post precedente (del quale non mi hai detto se hai provato la macro)
Devi avere un file con 12 fogli riportanti il nome del mese abbreviato a tre lettere (Gen, Feb, Mar etc)
inoltre inserirai un foglio che chiamerai "Riepilogo"
In un modulo inserisci queste macro (copa l'intero codice e incollalo nel modulo)
Codice: Seleziona tutto
Public MeseR, NomeF As String, CantiereR As Integer
Sub Avvio()
If UCase(ActiveSheet.Name) = "RIEPILOGO" And MeseR = "" Then
    Riepilogo
Else
    CompilaScCant
End If
End Sub
Sub CompilaScCant()
NomeFileCant = ThisWorkbook.Name
Perc = ThisWorkbook.Path & "\"
Anno = 2012
NFile = "Costi Operai Impiegati " & Anno & ".xls"
NomeF = ActiveSheet.Name
NomeFCP = ActiveSheet.Name
Application.ScreenUpdating = False
Application.Calculation = xlManual
If UCase(NomeF) = "RIEPILOGO" Then
NomeFCP = MeseR
End If
Set Ws1 = Worksheets(NomeFCP)
Select Case UCase(NomeFCP)
Case "GEN"
MM = 1
GG = 31
Case "FEB"
MM = 2
GG = 29
Case "MAR"
MM = 3
GG = 31
Case "APR"
MM = 4
GG = 30
Case "MAG"
MM = 5
GG = 31
Case "GIU"
MM = 6
GG = 30
Case "LUG"
MM = 7
GG = 31
Case "AGO"
MM = 8
GG = 31
Case "SET"
MM = 9
GG = 30
Case "OTT"
MM = 10
GG = 31
Case "NOV"
MM = 11
GG = 30
Case "DIC"
MM = 12
GG = 31
End Select
DataIni = DateSerial(Year(Date), MM, 1)
DataFine = DateSerial(Year(Date), MM, GG)

 Ws1.Range("P2").Value = DataIni
Ws1.Range("S2").Value = DataFine
If UCase(NomeF) = "RIEPILOGO" Then
MioCant = CantiereR
Worksheets(MeseR).Select
GoTo SaltaContr:
End If
Inizio:
MioCant = Application.InputBox("Cantiere")
If MioCant = "" Then
MsgBox "Digitare un Numero Cantiere"
GoTo Inizio
End If
SaltaContr:
MioCant = Val(MioCant)
If IsNumeric(MioCant) Then

If MioCant = 0 Then
MsgBox "Zero non è un Numero Cantiere - Digitare un Numero Cantiere <> da 0"
GoTo Inizio
End If
Ws1.Range("O2").Value = MioCant
Cantiere = MioCant
  Set MioCant = Nothing
    Ws1.Range("A5:M1000").ClearContents
    Ws1.Range("C4:H4").ClearContents
    Ws1.Range("A4").FormulaR1C1 = "GG "
    Ws1.Range("B4").FormulaR1C1 = "Data"
    Workbooks.Open Filename:=Perc & NFile
    Set Ws2 = Worksheets("Ore")
    Ws2.Activate
    UR2 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
    UC2 = Ws2.Cells(6, Columns.Count).End(xlToLeft).Column

    For RR2 = 7 To UR2
        If Ws2.Range("B" & RR2) > DataFine Then GoTo esci
        If Ws2.Range("B" & RR2) >= DataIni And Ws2.Range("B" & RR2) <= DataFine Then
       
        Workbooks(NomeFileCant).Activate
            For CC2 = 3 To UC2 Step 2
                If Ws2.Cells(RR2, CC2).Value = Cantiere Then
                    Operaio = Ws2.Cells(5, CC2).Value
                    NumO = Ws2.Cells(RR2, CC2 + 1).Value
                    DataC = Ws2.Cells(RR2, 2).Value
                    UC1 = Ws1.Range("A4").CurrentRegion.Columns.Count + 1
                    ColO = UC1
                    For CC1 = 3 To UC1
                        If Ws1.Cells(4, CC1).Value = Operaio Then
                            UR1 = Ws1.Cells(Rows.Count, CC1).End(xlUp).Row + 1
                            Ws1.Cells(UR1, CC1).Value = NumO
                            ColO = CC1
                            GoTo saltaCC1
                        End If
                    Next CC1
                    Ws1.Cells(4, UC1).Value = Operaio
saltaCC1:
                URS = Ws1.Cells(Rows.Count, 2).End(xlUp).Row + 1
                For RRS = 5 To URS

                If Ws1.Cells(RRS, 2).Value = DataC Then
                    Ws1.Cells(RRS, ColO).Value = NumO
                GoTo saltaRRS
                End If

                Next RRS
                Ws1.Cells(URS, 2).Value = DataC
                Ws1.Cells(URS, ColO).Value = NumO
                Ws1.Range("B" & URS).NumberFormat = "[$-410]d-mmm;@"
                Ws1.Range("A" & URS).FormulaR1C1 = "=RC[1]"
                Ws1.Range("A" & URS).NumberFormat = "ddd"
                Ws1.Range("A" & URS).HorizontalAlignment = xlLeft
                End If
saltaRRS:
            Next CC2


        End If
    Next RR2
esci:
    Workbooks(NFile).Close savechanges:=False
    URS = Ws1.Cells(Rows.Count, 2).End(xlUp).Row + 2
Ws1.Range("A" & URS).Value = "Tot ore lavorate"
Ws1.Range("A" & URS + 1).Value = "Costo Orario"
Ws1.Range("A" & URS + 2).Value = "Tot Costo"
UC1 = Ws1.Range("A4").CurrentRegion.Columns.Count
For CC1 = 3 To UC1
Ws1.Cells(URS, CC1).FormulaR1C1 = "=SUM(R[-" & URS - 3 & "]C:R[-2]C)"
Next CC1
End If
MeseR = ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub Riepilogo()
NomeFileCant = ThisWorkbook.Name
Perc = ThisWorkbook.Path & "\"
Anno = 2012
NFile = "Costi Operai Impiegati " & Anno & ".xls"
NomeFCant = ActiveSheet.Name
Set Ws1 = Worksheets(NomeFCant)
Ws1.Cells.ClearContents
Ws1.Range("A1").Value = "Mese"
Application.ScreenUpdating = False
Application.Calculation = xlManual
    Workbooks.Open Filename:=Perc & NFile
    Set Ws2 = Worksheets("Ore")
    Ws2.Activate
    UR2 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
    UC2 = Ws2.Cells(6, Columns.Count).End(xlToLeft).Column
    Workbooks(NomeFileCant).Activate
    For RR2 = 7 To UR2
        Tr = 0
        Mese = Application.WorksheetFunction.Proper(Format(Ws2.Range("B" & RR2), "mmm"))
        UC1 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        For RR1 = 2 To UC1
            If UCase(Mese) = UCase(Ws1.Cells(RR1, 1)) Then Tr = 1
        Next RR1
        If Tr = 0 Then
            Ws1.Cells(UC1, 1).Value = Mese
            If Mese = "Dic" Then Exit For
        End If
    Next RR2
    For RR2 = 7 To UR2
        Mese = Application.WorksheetFunction.Proper(Format(Ws2.Range("B" & RR2), "mmm"))
        URS = Ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
        For RR1 = 2 To URS
            If UCase(Mese) = UCase(Ws1.Cells(RR1, 1)) Then
                For CC2 = 3 To UC2 Step 2
                    Tr = 0
                    Cantiere = Ws2.Cells(RR2, CC2).Value
                    If Cantiere = "" Then GoTo SaltaCC2
                    UC1 = Ws1.Cells(RR1, Columns.Count).End(xlToLeft).Column + 1
                    For CC1 = 2 To UC1
                        If Ws1.Cells(RR1, CC1).Value = Cantiere Then
                            'Tr = 1
                            GoTo SaltaCC2
                        End If
                    Next CC1
                    If Tr = 0 Then
                    Ws1.Cells(1, UC1).Value = "Cantiere"
                    Ws1.Cells(RR1, UC1).Value = Cantiere
                    End If
SaltaCC2:
                Next CC2
            End If
            Next RR1
    Next RR2
    Workbooks(NFile).Close savechanges:=False
End Sub


Inoltre nel Vba del foglio "Riepilogo"
inserisci questo codice
Codice: Seleziona tutto
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = "B2:IV13"
If Target = "" Then Exit Sub
RigaR = Target.Row
If Not Application.Intersect(ActiveCell, Range(CheckArea)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then GoTo SaltaAA
    MeseR = Range("A" & RigaR).Value
    CantiereR = Target.Value
    NomeF = Name
    Avvio
End If
SaltaAA:
End Sub


Aggiungi il comando tasto veloce Ctrl+m alla macro "Avvio"

ora hai queste possibilità:
1) Se ti trovi nel foglio Riepilogo, qualsiasi cella piena (con numero Cantiere) che viene selezionata avvierà la macro relativa al mese (corrispondenza col A) e compilerà il foglio mese con relativo cantiere selezionato

2) Sempre nel foglio Riepilogo, selezionando una cella vuota e premendo Ctrl+m si ricompilerà il foglio Riepilogo aggiornandolo

3) Premendo il comando Ctrl+m da qualsiasi altro foglio (mese) si potrà avere il resoconto del relativo mese in funzione del cantiere digitato nell'apposito box

Allego il file test

Ciao

EDIT: ci siamo accavallati con i post (intanto invio e aspetto riscontro del lavoro svolto e studierò anche il tuo file)
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Estrapolare dati

Postdi diego.brero » 27/10/12 06:08

Si l'ho provata e funziona,
anche se io devo sempre crearmi una tasto per far partire la macro, perchè mi funziona solo il tasto
CTRL di destra, in quanto sto aspettando la nuova tastiera (il mio bimbo di 3 anni ha pensato bene di togliermi tutti i tasti e quando l'ho rimontata ALT , CTRL e <> di sx erano rotti), bando alle ciance,
preferisco però quella che mi hai appena postato col foglio di riepilogo, anche se mi piacerebbe di più ancora abbinare il foglio di riepilogo che mi hai creato con il file che ti ho spedito nel mio ultimo post, in quanto quello che mi interessa è di avere
una visione completa di ogni singolo cantiere (quando ho lavorato, chi, quali giorni, e le relative spese).
Sempre che si possa fare.

Ciao
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Re: Estrapolare dati

Postdi Flash30005 » 27/10/12 23:57

Se abbini Ctrl+m (nelle opzioni) alla macro "Avvio"
puoi usare il Ctrl sulla destra della tastiera, chiaramente insieme alla lettera "m"

ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Estrapolare dati

Postdi diego.brero » 28/10/12 17:40

Ho capito e provato, ma non funziona.

ciao
diego.brero
Utente Junior
 
Post: 23
Iscritto il: 15/10/12 11:31

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Estrapolare dati":


Chi c’è in linea

Visitano il forum: patel e 6 ospiti