spero sia utile in quanto ho incontrato un paio di casi da risolvere che possono capitare. scartabbellando nel web ho trovato soluzioni utili per la gestione di un database complesso. Soprattutto se si tratta di elaborare tabelle in sequenza collegate tra loro in merito ai nomi del file e dei fogli sui quali s'impostano elaborazioni successive.
Una delle soluzioni più utili, penso, è quella di porre a zero le celle vuote perchè altrimenti risulta problematico copiare valori in un altro foglio per fare un report e sommare i valori.
Partiamo da un file che contiene varie tabelle che devono essere formattate senza spazi, titoli, immagini jpeg, ecc. quindi devono essere ridotte ad un database omogeneo che in riga 1 contenga i nomi dei campi. La classica tabella da caricare in Access per ulteriori elaborazioni.
Soluzione
registare macro che fa quanto necessario per ottenere tabella omogena da caricare in Access. Funziona perchè sono azioni semplici e ripetitive che non hanno indicizzazioni in quanto le tabelle hanno tutte lo stesso standard.
La tabella che contiene i dati viene poi trasferita in File destinazione che contiene il programma. In fondo posto il codice per cancellare le tabelle del precedente lancio che è la macro che va lanciata per prima.
Addesso l'esigenza è salvare questo file con un nome specifico.
Il file contiene una tabella che non mi serve e che non formatto quindi mi appoggio in questa tabella (se non c'è nel file orgine aggiungo un foglio) e inserisco in modulo il seguente codice
- Codice: Seleziona tutto
Dim nome_file As String
Application.Dialogs(xlDialogOpen).Show
Sheets("Tbl_appoggio").Select
Range("AA1").Value = "Tabella_dati"
nome_file = ActiveWorkbook.Sheets("tabella_appoggio").Range("AA1").Text
Application.Dialogs(xlDialogSaveAs).Show nome_file
Sheets("Tbl_appoggio").Select
Range("AA1").Value = ""
Se dovessi aggiungere un foglio per fare quanto sopra
- Codice: Seleziona tutto
Worksheets.Add 'aggiungiamo un nuovo foglio
ActiveSheet.Name = "DB dati"
Adesso voglio unire tutte le tabelle in una sola. Di seguito il codice per unire due tabelle
- Codice: Seleziona tutto
Application.DisplayAlerts = False
'Apre due file xlsx
Workbooks.Open Filename:=ActiveWorkbook.Path & "\File1.xlsx"
Workbooks.Open Filename:=ActiveWorkbook.Path & "\FIle2.xls"
'Sposta foglio "File2.xlsx" in file "File1.xlsx"
'e cancella riga d'intestazione del foglio "File2.xlsx"
Sheets("FoglioFile2").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Sheets("FoglioFile2").Copy After:=Workbooks( _
"File1.xlsx").Sheets(1)
Dim fg As Integer
Dim uR As Long
Dim uR1 As Long
For fg = 2 To Sheets.Count
uR = Sheets(fg).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(fg).Range("A1:T" & uR).Copy
uR1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets(1).Cells(uR1, 1).PasteSpecial Paste:=xlValues
Next fg
Sheets("FoglioFile1").Select
Sheets("FoglioFile1").Name = "Tabella_lavoro" 'se serve rinomino il foglio del File1.xlsx
Cells.Select
Selection.AutoFilter
Sheets("FoglioFile2").Select
Sheets("FoglioFile2").Delete
'Imposta il nome del file finale come il nome della foglio
Dim nome_file As String
Workbooks("("FoglioFile1.xlsx").Worksheets("Tabella_lavoro").Activate
nome_file = ActiveSheet.Name
Application.Dialogs(xlDialogSaveAs).Show nome_file
'Chiude il file DB Tabella_lavoro.xlsx ed il File2.xlsx
Workbooks("Tabella_lavoro.xlsx").Close
Workbooks("File2.xlsx").Close
Application.DisplayAlerts = True
End Sub
Copia dati da un file ad un altro. Quindi il file Tabella_lavoro.xlsx è il file origine da copiare in un file di destinazione che contiene il programma
- Codice: Seleziona tutto
Sub Copia_dati_tra_due_file()
Application.DisplayAlerts = False
Workbooks("File_destinazione.xlsm").Activate
Worksheets.Add 'aggiungiamo un nuovo foglio
ActiveSheet.Name = "Foglio_destinazione"
Workbooks.Open Filename:=ActiveWorkbook.Path & "\Tabella_lavoro.xlsx"
Workbooks("Tabella_lavoro.xlsx").Activate
Sheets("Tabella_lavoro").Activate
' seleziono l'area
Range("A1").Select
Selection.End(xlDown).Select
Ultima = ActiveCell.Row
' seleziono l'area
Range("A1:Z" & Ultima).Select
Range("A1:Z" & Ultima).Copy
Workbooks("File_destinazione.xlsm").Activate
Sheets("Foglio_destinazione").Activate
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Selection.Columns.AutoFit
Selection.Rows.AutoFit
Sheets("Foglio_destinazione").Select
Sheets("Foglio_destinazione").Move After:=Sheets(2) 'Se voglio tenere i fogli in un certo ordine.Magari c'è un foglio 2 già presente
Workbooks("Tabella_lavoro.xlsx").Activate
WorkbooksTabella_lavoro.xlsx").Close
'Riattivo il foglio destinazione per successive elaborazioni
Workbooks("File_destinazione.xlsm").Activate
Sheets("Foglio_destinazione").Select
Range("A1").Select
Application.DisplayAlerts = True
End Sub
Questo copia - incolla è utile nel caso si voglia fare un pivot in quanto questa punta ad un foglio specifico e deve essere sempre quello altrimenti non funziona. Ho notato che se si cancellano i fogli vecchi e si fa un "copia e sposta foglio", funziona il primo giro ma non il secondo quindi con il copia - incolla si blinda il nome tabella e la pivot funziona in quanto si aggancia al foglio in modo corretto.
Adesso la tabella Pivot su Foglio_destinazione del file File_destinazione.xlsm
- Codice: Seleziona tutto
Sub PIVOT_su_Foglio_destinazione_del_file_File_destinazione()
Application.DisplayAlerts = False
Dim foglio As Worksheet
For Each foglio In Worksheets
If foglio.Name = "PIVOT" Then
Sheets("PIVOT").Delete
End If
Next foglio
' Creates a PivotTable report from the table on Sheet1
' by using the PivotTableWizard method with the PivotFields
' method to specify the fields in the PivotTable.
Dim objTable As PivotTable, objField As PivotField
' Select the sheet and first cell of the table that contains the data.
Sheets("Foglio_destinazione").Activate
Range("A1").Select
' Create the PivotTable object
Set objTable = Workbooks("Foglio_destinazione.xlsm").Sheets("Foglio_destinazione").PivotTableWizard
'Supponiamo debba essere sempre il Foglio2
' Create the PivotTable object based on the Employee data on Sheet1.
'Set objTable = Foglio2.PivotTableWizard
ActiveSheet.Name = "PIVOT" 'Rinomina foglio della tabella pivot
' Specify row and column fields.
Set objField = objTable.PivotFields("Campo1")
objField.Orientation = xlRowField
objField.Position = 1
Set objField = objTable.PivotFields("Campo2")
objField.Orientation = xlRowField
objField.Position = 2
Set objField = objTable.PivotFields("Campo3")
objField.Orientation = xlRowField
objField.Position = 3
Set objField = objTable.PivotFields("Campo4")
objField.Orientation = xlColumnField
objField.Position = 1
' Specify a data field with its summary
' function and format.
Set objField = objTable.PivotFields("Campo5")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Set objField = objTable.PivotFields("Campo6")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Set objField = objTable.PivotFields("Campo7")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Set objField = objTable.PivotFields("Campo8")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Cells.Select
Selection.Style = "Comma"
With Selection.PivotTable.DataPivotField
.Orientation = xlColumnField
.Position = 2
End With
Selection.PivotTable.PivotFields("Campo9"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo10" _
).Subtotals = Array(False, False, False, False, False, False, False, False, False, False _
, False, False)
Selection.PivotTable.PivotFields("Campo11"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo12"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFieldsCampo13"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo14"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo15"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo16").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
Selection.PivotTable.PivotFields("Anno di Competenza"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo17"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo18").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)
Selection.PivotTable.PivotFields("Fornitore").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
Selection.PivotTable.PivotFields( _
"Campo19").Subtotals = Array(False, False, False, _
False, False, False, False, False, False, False, False, False)
Selection.PivotTable.PivotFields( _
"Campo20").Subtotals = Array(False, False, False, False _
, False, False, False, False, False, False, False, False)
Selection.PivotTable.PivotFields( _
"Campo21").Subtotals = Array(False, False, False, _
False, False, False, False, False, False, False, False, False)
Selection.PivotTable.PivotFields("Valore doc Impegnativo" _
).Subtotals = Array(False, False, False, False, False, False, False, False, False, False _
, False, False)
Selection.PivotTable.PivotFields("Campo22"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo23"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo24"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.PivotFields("Campo25"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
Selection.PivotTable.RepeatAllLabels xlRepeatLabels
Cells.Select
Selection.Style = "Comma"
'Fine:
' Exit Sub
' End If
Application.DisplayAlerts = True
Range("A1").Select
End Sub
Adesso prendiamo la tabella Pivot e la copiamo in un altro foglio per fare dei filtri
- Codice: Seleziona tutto
Application.DisplayAlerts = False
Dim foglio As Worksheet
For Each foglio In Worksheets
If foglio.Name = "TabellaDaFormattare" Then
Sheets("TabellaDaFormattare").Delete
End If
Next foglio
Sheets("PIVOT").Select
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
'Ordino le tabelle
Sheets("PIVOT").Copy Before:=Sheets("Foglio_destinazione")
Sheets("PIVOT (2)").Select
Sheets("PIVOT (2)").Name = "TabellaDaFormattare"
Sheets("PIVOT").Select
Sheets("PIVOT").Move After:=Sheets("Foglio_destinazione")
Sheets("TabellaDaFormattare").Select
Sheets("TabellaDaFormattare").Move After:=Sheets("PIVOT")
'Fine:
'Exit Sub
'End If
Application.DisplayAlerts = True
End Sub
Sub Formatta_tabella_TabellaDaFormattare()
'
' Formatta_tabella_TabellaDaFormattare'
Application.DisplayAlerts = False
Sheets("TabellaDaFormattare").Select
'Copia incolla valori derivanti dalla tabella pivot
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Inserisce e cancella colonne
Columns("AB:AC").Select
Selection.Delete Shift:=xlToRight
'Inserisce colonne
Columns("AD:AE").Select
Selection.Insert Shift:=xlToRight
Nuove descirzioni
Range("AD3").Value = "Descrizione campo"
Range("AE3").Value = "Descrizione campo"
Adesso nel foglio che occorre inserire una formula. La soluzione adottata, forse poco elegante ma efficace, è mettere il valore 1 nell'ultima cella utile che indica alla macro fino a dove deve copiare la formula
- Codice: Seleziona tutto
Range("A3").Select
' va in ultima cella piena colonna A
Selection.End(xlDown).Select
' scende nella cella successiva
'ActiveCell.Offset(1).Select
' oppure: scende e si sposta di 4 celle a DX
ActiveCell.Offset(0, 4).Select
' Attribuisce valore 1 all'ultima cella della colonna D altrimenti non si riesce a far copiare la formula fino alla
' fine in modo corretto
Selection.Value = 1
Worksheets("TabellaDaFormattare").Range("E4").FormulaLocal = "=+D4-F4-J4"
Range("E4").Select
Selection.Copy
Range("E5:E" & Cells(Rows.Count, "E").End(xlUp).Row).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
Elimina la riga con il "Totale complessivo" della tabella pivot se non serve
- Codice: Seleziona tutto
Dim uR As Integer
With Sheets("TabellaDaFormattare")
uR = .Cells(Rows.Count, 1).End(xlUp).Row
For n = uR To 2 Step -1
If .Cells(n, 1).Value = "Totale complessivo" Then
.Cells(n, 1).EntireRow.Delete
End If
Next n
End With
Filtri.
Ho trovato questo modo sul sito Ennius e l'ho adattato alle mie esigenze combinandolo con altro codice
- Codice: Seleziona tutto
'In colonna CAMPO10 si aggiorna PIPPO in PIPPO - PLUTO
'in base all'importo 0 e minore di 0 in colonna CAMPO15
Set TabellaDaFormattare = ActiveSheet.UsedRange
x = TabellaDaFormattare.Columns.Count
Dim Campo
Dim Criterio
'Campo = InputBox("Inserire il numero del campo di ricerca")
' If Campo = "" Then Exit Sub
If Val(Campo) > x Then
MsgBox "N° Campo non presente"
Exit Sub
End If
'Criterio = InputBox("Inserire il criterio di ricerca")
'If Criterio = "" Then Exit Sub
'Dim CL As Object
'Set pippo = TabellaDaFormattare.Cells(1, Val(Campo))
'For Each CL In Range(pippo, pippo.End(xlDown))
'If CL.Value = Int(Criterio) Then
' If CL.Value = Val(Criterio) Then
' If CL.Value = Criterio Then
' GoTo 10
' End If
' Next
' MsgBox "Criterio Non presente"
' Exit Function
'10:
Rows("3:3").Select
Selection.AutoFilter
Selection.AutoFilter Field:=10, Criteria1:="PIPPO"
Selection.AutoFilter Field:=15, Criteria1:="<=0.1"
' Selection.AutoFilter Field:=Campo, Criteria1:=Criterio
'Da riga 8 iniziano i valori dei campi
Range("C8").Select
colonna = Selection.Column
uriga = Cells(Rows.Count, colonna).End(xlUp).Row
Set area = Range(Cells(3, colonna), Cells(uriga, colonna)).SpecialCells(xlCellTypeVisible)
area.Select
Dim sh As Worksheet
Dim rng As Range
Dim C As Range
Set sh = ThisWorkbook.Worksheets(" TabellaDaFormattare")
With TabellaDaFormattare
Set rng = .Range(Cells(3, colonna), Cells(uriga, colonna)).SpecialCells(xlCellTypeVisible)
For Each C In rng
C.Value = "PIPPO - PLUTO"
Next
End With
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
'Torna in A1
Range("A1").Select
Ordinare i dati
- Codice: Seleziona tutto
Sub Ordina_crescente()
'Ordina in ordine crescente un numero
' Dim sh As Worksheet
' Dim rng As Range
' Dim c As Range
' Set sh = ThisWorkbook.Worksheets("TabellaDaFormattare")
' With sh
' Set rng = .Range("D4:D" & Cells(Rows.Count, "D").End(xlUp).Row)
' For Each c In rng
Sheets("TabellaDaFormattare").Select
ActiveWorkbook.Worksheets("TabellaDaFormattare").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TabellaDaFormattare").AutoFilter.Sort.SortFields.Add Key:=Range( _
("D4:D" & Cells(Rows.Count, "D").End(xlUp).Row)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("TabellaDaFormattare").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Next
'End With
End Sub
Cancellare dati, per esempio in base ad un filtro su un numero
- Codice: Seleziona tutto
Sub Cancella_importo()
Application.DisplayAlerts = False
Sheets("TabellaDaFormattare").Select
Range("A8").Select 'Da riga otto iniziano i valori dei campi
prima = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) 'salva la coordinata
'*** si posiziona sull'ultima cella attiva
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
Ultima = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) 'coordinate cella
ActiveSheet.Range(prima, Ultima).AutoFilter Field:=4, Criteria1:="<1500", _
Operator:=xlAnd
sel_area = Range(prima, Ultima).Delete ' Seleziona l'area e cancella le righe selezionate
Range("A1").Select
If ActiveSheet.FilterMode = True Then
ActiveSheet.ShowAllData
End If
Application.DisplayAlerts = True
End Sub
Dove trova spazio mette zero
- Codice: Seleziona tutto
Sub Riempie_spazi_con_zero()
Sheets("TabellaDaFormattare").Select
Dim Miorange As Range
Dim cel As Range
' trova l'ultima riga del foglio Stampe
Range("D8").Select
Selection.End(xlDown).Select
Ultima = ActiveCell.Row
' seleziono l'area
Range("D8:Z" & Ultima).Select
Set Miorange = Range("D8:Z" & Ultima)
For Each cel In Miorange
If cel.Value = "" Then
cel.Value = 0
End If
Next cel
End Sub
Per pulire il file destinazione dalle tabelle del precedente lancio
- Codice: Seleziona tutto
Sub Cancella_le_tabelle()
Application.DisplayAlerts = False
'Elimina tutti fogli tranne quello attivo
Sheets("Master").Select 'Contiene le istruzioni e il pulsante avvio programma
Dim sh As Worksheet
Dim tSh As Worksheet
Set sh = ActiveSheet
For Each tSh In ThisWorkbook.Worksheets
If tSh.Name = sh.Name Then
Else
tSh.Delete
End If
Next
Application.EnableEvents = True
End Sub