Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Gestione data base in excel

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

Gestione data base in excel

Postdi EnricoBanco » 13/03/18 12:46

Ciao a tutti,

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
EnricoBanco
Utente Junior
 
Post: 65
Iscritto il: 18/07/17 06:29

Sponsor
 

Re: Gestione data base in excel

Postdi Anthony47 » 13/03/18 14:51

Grazie per la condivisione.
Il massimo sarebbe allegare anche un file esemplificativo che aiuti a sperimentare quanto pubblicato.
Ci provi? Graaazzzie
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15531
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Gestione data base in excel

Postdi EnricoBanco » 14/03/18 22:37

Ecco l'esempio, il file master contiene le spiegazioni delle macro (anche una macro che esegue alcune call), ho aggiunto un paio di macro. Crea pdf e crea grafico fisso e dinamico:

http://www.filedropper.com/esempiodiges ... croexcel_1

Oppure:
https://www.dropbox.com/s/6ng9tknslql20 ... 4.zip?dl=0

Ho trovato il modo di creare un grafico con selezione dinamica dei combinando la macro che crea il pdf con quella che crea il grafico con range fisso. Mi sembra utile
EnricoBanco
Utente Junior
 
Post: 65
Iscritto il: 18/07/17 06:29


Torna a Applicazioni Office Windows


Topic correlati a "Gestione data base in excel":


Chi c’è in linea

Visitano il forum: oz85 e 40 ospiti