creare un file inventario

[babu52]

Ho una cartella di nome PRODOTTI in C:\ nella quale ho altre sottocartelle che identificano i fornitori.
In ognuna di queste ho alcuni file .xls relativi ai vari prodotti che contengono informazioni circa data,fattura e quantità.
Sfruttando una macro che mi aveva fornito Flash per un'esigenza analoga ho creato in ogni cartella un file inventario dove dopo l'intestazione ho 2 colonne : A=nome del prodotto B=quantità.
Fin qui tutto ok ora nasce l'esigenza di avere in PRODOTTI un file inventario "degli inventari" composto da :
A=nome fornitore (uguale nome cartella oppure C1 del relativo inventario)
B=nome prodotto (preso dall'inventario)
C=quantità (presa dall'inventario)
Nella prima riga la dicitura Aggiornata al in A1 e la data dell'esecuzione in B1
Riporto il link del file caricato qualora servisse
https://rapidshare.com/files/2666557619/PRODOTTI.zip

[Flash30005]

Apri un nuovo file di excel
Nel foglio1, Riga1 inserirai la testata
A1 = FORNITORE
B1 = PRODOTTO
C1 = Q.TA'
F1 = Aggiornato al
In un modulo inserisci questa macro

Codice: Seleziona tutto

Public NomeF As String
Public perc As String

Sub ElencoFileXls()
Application.ScreenUpdating = False
Application.Calculation = xlManual
perc = "C:\PRODOTTI\"
NomeF = ThisWorkbook.Name
Worksheets("Foglio1").Select
Range("A1").Select
With ActiveCell
    Worksheets("Foglio1").Range(.Cells(2, 3), .End(xlDown)).ClearContents
End With
Trova Direct:=perc, Estens:="*.xls", Inicell:=ActiveCell
Range("G1").Value = Date
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub Trova(Direct As String, Estens As String, Inicell As Range)
    Set fs = Application.FileSearch
    With fs
        .LookIn = perc
        .SearchSubFolders = True
        .Filename = Estens
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                FileT = .FoundFiles(i)
                NFileP = Replace(FileT, UCase(perc), "")
                NFile = Mid(NFileP, InStr(NFileP, "\") + 1, Len(NFileP))
                If UCase(NFile) <> "INVENTARIO" And NFile <> NomeF Then
                    URF = Workbooks(NomeF).Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row + 1
                    Workbooks.Open(FileT).Activate
                    Range("A2").Copy Destination:=Workbooks(NomeF).Sheets("Foglio1").Cells(URF, 1)
                    Range("C2").Copy Destination:=Workbooks(NomeF).Sheets("Foglio1").Cells(URF, 2)
                    URT = Range("A" & Rows.Count).End(xlUp).Row
                    Range("C" & URT).Copy
                    Workbooks(NomeF).Sheets("Foglio1").Cells(URF, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
                    Workbooks(NFile).Close savechanges:=False
                End If
            Next i
        End If
    End With

End Sub


Inserisci un comando nel foglio1 che attivi la macro "ElencoFileXls"

Questa macro non apre i tuoi file "inventario.xls" ma apre ogni singolo file esistente nelle sottocartelle di "Prodotti"
(anche eventuali file contenuti nella cartella "Prodotti"), questo file può essere contenuto nella cartella.
Alla fine avrai un elenco ordinato alfabeticamente per prodotto con le quantità totali trovate nei singoli file.

Ciao

[babu52]

Flash come sempre sei grande.
L'unica cosa che ti chiedo è se i dati scritti nell'inventario globale invece che per prodotto possono essere ordinati per fornitore; è possibile eventualmente lasciare commentata nella macro l'istruzione attuale qualora un domani volessero ...
Poi quando eseguo la macro che ho associato ad un bottone, mi toglie i bordi delle prime 2 colonne.
Ti invio il link del nuovo caricamento nel quale vi è anche l'inventario che ho ottenuto così puoi verificare.
Grazie 1000 di nuovo
https://rapidshare.com/files/4124550275/PRODOTTI.zip

[Flash30005]

Per quanto riguarda i bordi delle colonne sostituisci questa macro nel modulo (o solo le due righe evidenziate)

Codice: Seleziona tutto

Private Sub Trova(Direct As String, Estens As String, Inicell As Range)
    Set fs = Application.FileSearch
    With fs
        .LookIn = perc
        .SearchSubFolders = True
        .Filename = Estens
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                FileT = .FoundFiles(i)
                NFileP = Replace(FileT, UCase(perc), "")
                NFile = Mid(NFileP, InStr(NFileP, "\") + 1, Len(NFileP))
                If UCase(NFile) <> "INVENTARIO" And NFile <> NomeF Then
                    URF = Workbooks(NomeF).Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row + 1
                    Workbooks.Open(FileT).Activate
                    Workbooks(NomeF).Sheets("Foglio1").Cells(URF, 1).Value = Range("A2").Value '<<<< riga modificata
                    Workbooks(NomeF).Sheets("Foglio1").Cells(URF, 2).Value = Range("C2").Value '<<< riga modificata
                    URT = Range("A" & Rows.Count).End(xlUp).Row
                    Range("C" & URT).Copy
                    Workbooks(NomeF).Sheets("Foglio1").Cells(URF, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
                    Workbooks(NFile).Close savechanges:=False
                End If
            Next i
        End If
    End With
End Sub


Per l'ordinamento, inserisci questo codice nel vba del Foglio1

Codice: Seleziona tutto

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
CheckAreaX = "A1"
CheckAreaY = "B1"
CheckAreaZ = "C1"
Application.Calculation = xlManual
If Not Application.Intersect(Target, Range(CheckAreaX)) Is Nothing Then
    Columns("A:C").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
        Range("A1").Select
End If

If Not Application.Intersect(Target, Range(CheckAreaY)) Is Nothing Then
    Columns("A:C").Select
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
        Range("A1").Select
End If

If Not Application.Intersect(Target, Range(CheckAreaZ)) Is Nothing Then
    Columns("A:C").Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("B2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
        Range("A1").Select
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Potrai ordinare sia per Fornitore, sia per prodotto che per quantità ad ogni doppio click del mouse rispettivamente sulle celle A1, B1, C1

ciao

[babu52]

Flash scusami per il disturbo.
Ho inserito le 2 righe da te indicate nella sub trova, mi ha sistemato la colonna B ma la A è come prima.
Poi per quanta riguarda l'ordinamento ho inserito il codice ma facendo il doppio click sulle celle A1 o B1 o C1non succede nulla se non che potrei modificare quanto scritto nelle stesse celle. Sicuramente avrò fatto una cappellata.
Questo è il nuovo link https://rapidshare.com/files/1716984166/MAGAZZINO.zip
ma se sei busy lascia perdere farò un sort per la colonna richiesta .
Ciao e grazie

[Flash30005]

C'era un errore nel Tag CODE che non ha separato le due macro come vedi ora (dopo l'Edit)
La seconda macro va nel Vba del foglio e non nel modulo

Non capisco perché hai inviato un archivio contenente cartelle fornitori ma non il file programma da te modificato
comunque ti invio il file programma come l'ho impostato io.
download file

Ciao

[babu52]

Caro Flash mi succede una cosa strana. Ho scaricato sul mio pc di casa il file inventario2 al quale hai aggiunto "Macro1" per fare il sort su uno dei 3 campi a scelta con doppio click e funziona meravigliosamente.
L'ho copiato e trasferito sui pc aziendali e quando faccio il doppio click su una delle 3 etichette mi prendo un errore
"Errore di runtime 1004. Errore definito dall'applicazione o dall'oggetto"
Ho preso e risalvato su una chiavetta la cartella PRODOTTI con inventario2 compreso l'ho riscaricato sul mio pc e funziona tutto.
Non centrerà nulla, ma l'unica cosa strana che ho notato su quei pc è che mi vengono selezionate automaticamente un tot numero di celle delle 3 colonne.
Grazie