Copiare celle A1,A2,A3,A4 da più file, su file "resoconto" solo se una tra A2,A3 e/o A4 è piena

Question

Buongiorno,

è la prima volta che utilizzo la vs assistenza.

Ho un elenco di file excel strutturati in maniera identica contenenti pero intestazioni e conteggi diversi.

Avrei necessita di riportare su un file "resoconto generale" la copia di quei conteggi ma solo se sono superiori allo 0, ed insieme l'intestazione del file stesso.

Ovvero, all'interno della cartella "Conteggi" ho i seguenti file

• File1A1: Rossi Piero (intestazione file)

A2: 5

A3: 2

A4: 8

• File2A1: Bianchi Luigi (intestazione file)

A2: 0

A3: 1

A4: 0

• File3

A1: Verdi Cinzia (intestazione file)

A2: 0

A3: 0

A4: 0

**..e cosi via per altri file che possono essere aggiunti nella cartella "Conteggi"**Avrei bisogno di creare un file "resoconto" che riporti i valore di A1 (ovvero l'intestazione del file) e a lato la copia dei relativi valori di A2,A3,A4 ma solamente se uno di questi 3 è superiore allo zero. I problemi sono:

• i valori di A2,A3,A4 all'interno dei vari file cambiano costantemente, quindi se A4 del file 3 oggi =0, a seguito di movimenti può diventare =1, quindi il file "resoconto" dovrebbe riuscire a aggiornarsi e pulirsi automaticamente
• i file stessi vengono aggiunti nella cartella "conteggi", quindi se oggi ho da file 1 a file 3, domani aggiungerò file 4, dopodomani file 5 e cosi via

Grazie a tutti per l'eventuale collaborazione, resto disponibile per chiarimenti o quanto necessario.

Answer 1

Ciao FD_PiedPiper.

grazie mille per il lavoro che stai svolgendo, sei davvero molto gentile.

Prego!

Il tuo file funziona alla perfezione, ho modificato la directory per Conteggi e funziona ma ora non riesco a modificare IntervalloDati, quello che per te è A1:A4:

• A1 (Ovvero l'intestazione del file) corrisponde a C1
• B1 corrisponde a U2
• C1 corrisponde a V2
• D1 corrsponde a W2

Ti allego un archivio simile al tuo ma contenente 4 file nella directory Conteggistrutturati in maniera identica a quella effettiva. (sostitutivi dei tuoi File#1, File#2 e File#3)

Le celle U2, V2 e W2 sono il risultato di una MATR.SOMMA.PRODOTTO , spero non sia un problema, mentre la cella C1 è quella che contiene l'intestazione del file.

Di seguito link dropbox per l'archivio:  https://goo.gl/jzQ2G5

I problemi che hai riscontrato sono dovuti a due fatti:

• Le celle dell'intestazione ed i dati non è un intervallo di celle contiguo
• Le tre celle per i dati si trovono sulla stessa riga anzichè la stessa colonna.

Pertanto consegue che non si può caricare l'array dei dati (arrIn) con una semplice assegnazione come era possibile nel caso, originariamente indicato da te, di un intervalo contiguo e verticale. Quindi, prova quanto segue.

Nel modulo di codice dell'oggetto ThisWorkbook il codice rimane invariato, ossia:

'=========>>

Option Explicit

'--------->>

Private Sub Workbook_Open()

    Application.ScreenUpdating = False

    Call CleanOldData

    Call UnhideSheets

    Call CreateFileList

    Call LoadData

    Application.ScreenUpdating = True

End Sub

'--------->>

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim SH As Worksheet

    Me.Sheets(sFoglioWelcome).Visible = xlSheetVisible

    For Each SH In Me.Sheets

        With SH

            If .Name <> sFoglioWelcome Then

                .Visible = xlSheetVeryHidden

            End If

        End With

    Next SH

End Sub

'<<=========

Nel modulo standard, sostituisci il codice precedente con la seguente versione:

'=========>>

Option Explicit

Public destWB As Workbook

Public destSH As Worksheet

Public arrFile() As Variant

Public arrOut() As Variant

Public Const sPercorso As String = _

"C:\Users\Deca-\Desktop\FD_PiedPiper20171122_PROVA\PROVA\Conteggi"

Public Const sFoglioReport As String = "Report"                     '<<=== Modifica

Public Const sFoglioWelcome As String = "Benvenuto"           '<<=== Modifica

'--------->>

Public Sub UnhideSheets()

    Dim SH As Worksheet

    With destWB

        For Each SH In .Sheets

            SH.Visible = xlSheetVisible

        Next SH

        .Sheets(sFoglioWelcome).Visible = xlSheetVeryHidden

    End With

End Sub

'--------->>

Public Sub CreateFileList()

    Dim oFSO As Object

    Dim oFolder As Object

    Dim oFiles As Object

    Dim oFile As Object

    Dim i As Long, iFiles As Long, iCtr As Long

    Set oFSO = CreateObject("Scripting.FileSystemObject")

    Set oFolder = oFSO.GetFolder(sPercorso)

    Set oFiles = oFolder.Files

    iFiles = oFiles.Count

    ReDim arrFile(1 To iFiles)

    For Each oFile In oFiles

        iCtr = iCtr + 1

        arrFile(iCtr) = oFile.Name

    Next oFile

End Sub

'--------->>

Public Sub CleanOldData()

    Set destWB = ThisWorkbook

    Set destSH = destWB.Worksheets(sFoglioReport)

    destSH.Cells.ClearContents

End Sub

'--------->>

Public Sub LoadData()

    Dim srcWB As Workbook

    Dim srcSH As Worksheet

    Dim srcRngDati As Range, srcRngIntestazione As Range

    Dim destRng As Range

    Dim arrIn(1 To 4) As String

    Dim sStr As String, sPath As String, sFullName As String

    Dim i As Long, j As Long, k As Long

    Dim UB As Long, iCtr As Long

    Dim CalcMode As Long

    Const sIntervalloIntestazione As String = "C1"                 '<<=== Modifica

    Const sIntervalloDati As String = "U2:W2"                        '<<=== Modifica

    UB = Range(sIntervalloDati).Cells.Count   '\ Any sheet!

    On Error GoTo XIT

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

        sStr = .PathSeparator

    End With

    If Right(sPercorso, 1) = sStr Then

        sPath = sPercorso

    Else

        sPath = sPercorso & sStr

    End If

    For i = 1 To UBound(arrFile)

        sFullName = sPath & arrFile(i)

        Set srcWB = Workbooks.Open(sFullName)

        Set srcSH = srcWB.Sheets(1)

        With srcSH

            Set srcRngIntestazione = srcSH.Range(sIntervalloIntestazione)

            Set srcRngDati = srcSH.Range(sIntervalloDati)

        End With

        If Application.Sum(srcRngDati) <> 0 Then

            iCtr = iCtr + 1

            arrIn(1) = srcRngIntestazione.Value2

            For j = 1 To srcRngDati.Rows.Count - 1

                arrIn(i + 1) = srcRngDati.Cells(i).Value2

            Next j

            ReDim Preserve arrOut(1 To UB, 1 To iCtr)

            For k = 1 To UB

                arrOut(k, iCtr) = arrIn(k)

            Next k

        End If

        srcWB.Close SaveChanges:=False

    Next i

    If CBool(iCtr) Then

        Set destRng = destSH.Range("A1").Resize(iCtr, UB)

        With destRng

            .Value2 = Application.Transpose(arrOut)

            .Columns(1).EntireColumn.AutoFit

        End With

    End If

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

'--------->>

Public Function SheetExists(sSheetName As String, _

                            Optional ByVal WB As Workbook) As Boolean

    On Error Resume Next

    If WB Is Nothing Then

        Set WB = ThisWorkbook

    End If

    SheetExists = CBool(Len(WB.Sheets(sSheetName).Name))

    On Error GoTo 0

End Function

'<<=========

Esguendo il codice co i tuoi quattro file ottemngo i seguenti dati nel foglio Report:

     

Potresti scaricare il mio file di prova FD_PiedPiper20171123.xlsm

===

Regards,

Norman

Answer 2

Ciao Norman,

grazie mille per il lavoro che stai svolgendo, sei davvero molto gentile.

Il tuo file funziona alla perfezione, ho modificato la directory per Conteggi e funziona ma ora non riesco a modificare IntervalloDati, quello che per te è A1:A4:

• A1 (Ovvero l'intestazione del file) corrisponde a C1
• B1 corrisponde a U2
• C1 corrisponde a V2
• D1 corrsponde a W2

Ti allego un archivio simile al tuo ma contenente 4 file nella directory Conteggistrutturati in maniera identica a quella effettiva. (sostitutivi dei tuoi File#1, File#2 e File#3)

Le celle U2, V2 e W2 sono il risultato di una MATR.SOMMA.PRODOTTO , spero non sia un problema, mentre la cella C1 è quella che contiene l'intestazione del file.

Di seguito link dropbox per l'archivio:  https://goo.gl/jzQ2G5

Grazie mille

Answer 3

Ciao FD_PiedPiper,

Innanzitutto, devo complimentarmi con te per la chiarezza con cui hai risposto alle mie domande!

Ho scritto il codice in modo che, all'apertura del file Resoconto, vengano eseguite le seguenti operazioni:

• I dati esistenti sul foglio di rapporto vengono cancellati
• I nomi di tutti i file nella directory Conteggio vengono caricati in un array (arrFile)
• Questi file sono aperti silenziosamente, in modalità nascosta
• Purchè almeno una delle celle A2: A4 ha un valore superiore a zero,  i dati nelle celle A1:A4 vengono caricati in un array di report (arrOut)
• Il file conteggio viene chiuso silenziosamente
• Non appena tutti i file nella directory Conteggio siano stati gestiti, i dati nell'array arrOut vengono ordinati per nome e i dati nell'array vengono caricati nel foglio (vuoto) Report

Tutte queste operazioni vengono eseguite in modo estremamente rapido, durante il caricamento del file Resoconto, e l'utente sarà ignaro dell'aggiornamento dei dati che si verificheranno durante la normale apertura del file.

Chiaramente, tutte queste azioni richiedono che le macro siano state abilitate e, se un utente dovesse aprire il file senza abilitare le macro, c'è il rischio che i dati nel foglio di report non siano stati aggiornati.

Per evitare questa spiacevole possibilità, il mio codice funziona anche nel modo seguente:

• Per impostazione predefinita,il foglio Report è nascosto e non può essere aperto dall'interfaccia utente; l'unico foglio visibile sarà  un foglio di benvenuto con un avviso
• Se il file viene aperto con i macro abilitati, il codice nasconde il foglio di benvenuto e scopre il foglio Report e altri fogli eventualmente presenti
• Se, però, il file dovesse essere aperto senza che lke macro siano state abilitate, solo il foglio Benvenuto sarà visibile e ci sarà un avviso per benvenuto informare l'utente della necessità di abilitare i macro

Quindi prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'=========>>

Option Explicit

Public destWB As Workbook

Public destSH As Worksheet

Public arrFile() As Variant

Public arrOut() As Variant

Public Const sPercorso As String = _

       "C:\Users\NDJ\Documents\Conteggi"                           '<<=== Modifica

Public Const sFoglioReport As String = "Report"                     '<<=== Modifica

Public Const sFoglioWelcome As String = "Benvenuto"         '<<=== Modifica

'--------->>

Public Sub UnhideSheets()

    Dim SH As Worksheet

    With destWB

        For Each SH In .Sheets

            SH.Visible = xlSheetVisible

        Next SH

        .Sheets(sFoglioWelcome).Visible = xlSheetVeryHidden

    End With

End Sub

'--------->>

Public Sub CreateFileList()

    Dim oFSO As Object

    Dim oFolder As Object

    Dim oFiles As Object

    Dim oFile As Object

    Dim i As Long, iFiles As Long, iCtr As Long

    Set oFSO = CreateObject("Scripting.FileSystemObject")

    Set oFolder = oFSO.GetFolder(sPercorso)

    Set oFiles = oFolder.Files

    iFiles = oFiles.Count

    ReDim arrFile(1 To iFiles)

    For Each oFile In oFiles

        iCtr = iCtr + 1

        arrFile(iCtr) = oFile.Name

    Next oFile

End Sub

'--------->>

Public Sub CleanOldData()

    Set destWB = ThisWorkbook

    Set destSH = destWB.Worksheets(sFoglioReport)

    destSH.Cells.ClearContents

End Sub

'--------->>

Public Sub LoadData()

    Dim srcWB As Workbook

    Dim srcSH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim arrIn As Variant

    Dim sStr As String, sPath As String, sFullName As String

    Dim i As Long, j As Long

    Dim UB As Long, iCtr As Long

    Dim CalcMode As Long

    Const sIntervalloDati As String = "A1:A4"                 

    UB = Range(sIntervalloDati).Cells.Count       '\ Any sheet!

    '    On Error GoTo XIT

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

        sStr = .PathSeparator

    End With

    If Right(sPercorso, 1) = sStr Then

        sPath = sPercorso

    Else

        sPath = sPercorso & sStr

    End If

    For i = 1 To UBound(arrFile)

        sFullName = sPath & arrFile(i)

        Set srcWB = Workbooks.Open(sFullName)

        Set srcSH = srcWB.Sheets(1)

        Set srcRng = srcSH.Range(sIntervalloDati)

        If Application.Sum(srcRng) <> 0 Then

            iCtr = iCtr + 1

            arrIn = srcRng.Value2

            ReDim Preserve arrOut(1 To UB, 1 To iCtr)

            For j = 1 To UB

                arrOut(j, iCtr) = arrIn(j, 1)

            Next j

        End If

        srcWB.Close SaveChanges:=False

    Next i

    If CBool(iCtr) Then

    arrOut = Application.Transpose(arrOut)

     QuickSort arrOut, 1, 1, iCtr, True

        Set destRng = destSH.Range("A1").Resize(iCtr, UB)

        With destRng

            .Value2 = arrOut

            .Columns(1).EntireColumn.AutoFit

        End With

    End If

XIT:

    With Application

        .Calculation = CalcMode

        .ScreenUpdating = True

    End With

End Sub

'--------->>

Public Function SheetExists(sSheetName As String, _

                            Optional ByVal WB As Workbook) As Boolean

    On Error Resume Next

    If WB Is Nothing Then

        Set WB = ThisWorkbook

    End If

    SheetExists = CBool(Len(WB.Sheets(sSheetName).Name))

    On Error GoTo 0

End Function

'--------->>

Public Sub QuickSort(SortArray, col, L, R, bAscending)

'\ TomOgilvy: http://goo.gl/ninpZW

'Originally Posted by Jim Rech 10/20/98 Excel.Programming

'Modified to sort on first column of a two dimensional array

'Modified to handle a second dimension greater than 1 (or zero)

'Modified to do Ascending or Descending

    Dim i, j, X, Y, mm

    i = L

    j = R

    X = SortArray((L + R) / 2, col)

    If bAscending Then

        While (i <= j)

            While (SortArray(i, col) < X And i < R)

                i = i + 1

            Wend

            While (X < SortArray(j, col) And j > L)

                j = j - 1

            Wend

            If (i <= j) Then

                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)

                    Y = SortArray(i, mm)

                    SortArray(i, mm) = SortArray(j, mm)

                    SortArray(j, mm) = Y

                Next mm

                i = i + 1

                j = j - 1

            End If

        Wend

    Else

        While (i <= j)

            While (SortArray(i, col) > X And i < R)

                i = i + 1

            Wend

            While (X > SortArray(j, col) And j > L)

                j = j - 1

            Wend

            If (i <= j) Then

                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)

                    Y = SortArray(i, mm)

                    SortArray(i, mm) = SortArray(j, mm)

                    SortArray(j, mm) = Y

                Next mm

                i = i + 1

                j = j - 1

            End If

        Wend

    End If

    If (L < j) Then Call QuickSort(SortArray, col, L, j, bAscending)

    If (i < R) Then Call QuickSort(SortArray, col, i, R, bAscending)

End Sub

'<<========= 

Ctrl+R per aprire la finestra Project Explorer

Fai doppio clic su ThisWorkbook  (Questa_cartella_di_lavoro)

Incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Private Sub Workbook_Open()

    Application.ScreenUpdating = False

    Call CleanOldData

    Call UnhideSheets

    Call CreateFileList

    Call LoadData

    Application.ScreenUpdating = True

End Sub

'--------->>

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim SH As Worksheet

    Me.Sheets(sFoglioWelcome).Visible = xlSheetVisible

    For Each SH In Me.Sheets

        With SH

            If .Name <> sFoglioWelcome Then

                .Visible = xlSheetVeryHidden

            End If

        End With

    Next SH

End Sub

'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm

Potresti scaricare il mio file di prova FD_PiedPiper20171122.zip

Questo file zip comprende il mio file di prova Resoconto.xlsm, con il codice, e anche una sottocartella Conteggio con tre file File#1.xlsx, File#2.xlsx, File# 3.xlsx

===

Regards,

Norman

Answer 4

Ciao Norman e grazie.

Provo a rispondere in ordine:

• La directory Conteggi contiene solo i file di interesse
• I file nella directory Contegginon hanno ancora una nomenclatura stabilita, in quanto la procedura è ancora da attivare, verosimilmente il nome file sarà cosi composto:
  • Ancona - Rossi Mario - 01234567891
  • Bari - Bianchi Luigi - 11111111111
  • Cesena - Rossi Cinzia - 22222222222
  • Domodossola - Verdi Antonio - 33333333333
  • ..e cosi via, dove i numeri sono la P.iva o CF del cliente in questione. (Nella cella A1 del file saranno riportati solamente Città e Nominativo)
• La sequenza di ordinamento può essere casuale, purchè a Cliente X corrisponda sulla riga valore X1,X2,X3, a Cliente Y valore Y1,Y2,Y3 e cosi via. Se posti in maniera casuale potrei riordinarmeli alfabeticamente manualmente
• Se almeno una delle celle A2:A4 è superiore a zero, tutte e 3 le celle andrebbero copiate. Questo per avere il file Resoconto il più omogeno possibile
• Nel file resoconto una impostazione potrebbe essere quella da te suggerita, quindi A1=intestazione cliente X, B1,C1,D1 = valori cliente X
• Il file Resoconto è finale, ottiene i dati dagli altri file e viene utilizzato solo in consultazione,senza avere altri collegamenti a nulla

Volendo usare i riferimenti esatti questi sono: C1 = Intestazione cliente, U2,V2,W2 i tre valori da copiare in caso uno di questi sia maggiore di zero

File 1 -Ancona - Rossi Mario - 01234567891

Rossi Mario - Ancona	1	2	2

File 2 -Bari - Bianchi Luigi - 11111111111

Bianchi Luigi - Bari	2	0	2

File 3 -Cesena - Rossi Cinzia - 22222222222

Rossi Cinzia - Cesena	0	0	0

..e cosi via.

File Resoconto

Rossi Mario - Ancona	1	2	2
Bianchi Luigi - Bari	2	0	2

Come detto, i valori all'interno dei file cambiano e i file all'interno della directory aumentano.

Grazie mille

Answer 5

Ciao FD_PiedPiper,

Ho un elenco di file excel strutturati in maniera identica contenenti pero intestazioni e conteggi diversi.

Avrei necessita di riportare su un file "resoconto generale" la copia di quei conteggi ma solo se sono superiori allo 0, ed insieme l'intestazione del file stesso.

Ovvero, all'interno della cartella "Conteggi" ho i seguenti file

File1

A1: Rossi Piero (intestazione file)

A2: 5

A3: 2

A4: 8

File2

A1: Bianchi Luigi (intestazione file)

A2: 0

A3: 1

A4: 0

File3

A1: Verdi Cinzia (intestazione file)

A2: 0

A3: 0

A4: 0

..e cosi via per altri file che possono essere aggiunti nella cartella "Conteggi"

Avrei bisogno di creare un file "resoconto" che riporti i valore di A1 (ovvero l'intestazione del file) e a lato la copia dei relativi valori di A2,A3,A4 ma solamente se uno di questi 3 è superiore allo zero. I problemi sono:

i valori di A2,A3,A4 all'interno dei vari file cambiano costantemente, quindi se A4 del file 3 oggi =0, a seguito di movimenti può diventare =1, quindi il file "resoconto" dovrebbe riuscire a aggiornarsi e pulirsi automaticamente

i file stessi vengono aggiunti nella cartella "conteggi", quindi se oggi ho da file 1 a file 3, domani aggiungerò file 4, dopodomani file 5 e cosi viaLa directory Conteggi contiene solo i file di interesse?

• La directory Conteggi contiene solo i file di interesse?
• Qual è il metodo di nomenclatura per i file nella directory Conteggi?
• La sequenza in cui i dati dei vari file vengono ricordati nel file  resocontoè importante?
• Se almeno una delle celle A2:A4 sia superiore allo zero, tutte le tre celle dovrebbero essere copiate?
• Per il file resoconto, le tre celle dovrebbero essere copiate nelle colonne B:D della riga dell'intestazione?
• Ci sono altri file con collegamenti  o codice per pescare dati dal file resoconto?

===

Regards,

Norman