Estrazione, calcolo e stampa dati in Excel

[xaba]

Ciao a tutti, ho un problema, ho la soluzione in testa ma non so proprio da dove inizare per metterla in atto su excel.
Il file (che trovate qui https://rapidshare.com/files/515713012/ELENCO_CORSI.xls ) è un elenco di corsi svolti in diverse sedi durante tutti i mesi dell'anno. Per ogni corso, in ciascun mese, viene rilevato un valore pari al prodotto tra numero allievi e ore svolte. Nella colonna O viene fatta per ogni corso la somma delle ore allievo svolte. Nella colonna P viene calcolato, in formato percentuale, il rapporto tra il numero delle ore allievo del corso e il numero delle ore allievo complessive.
Il mio problema è creare una userform simile a questa ( https://rapidshare.com/files/1589802719/USERFORM.xls ) in cui inserire un importo variabile qualsiasi, indicare i mesi e le sedi da prendere in considerazione per ottenere un elenco stampabile con il nome di tutti i corsi che rispondono ai criteri presi in considerazione (ovvero che siano presenti nelle sedi e nei mesi considerati) e l'importo relativo. L'importo relativo per ciascun corso elencato deve essere pari al prodotto tra l'importo scritto nella userform e la percentuale di incidenza, ovvero il rapporto (espresso in termini percentuali) tra la somma delle ore allievo del corso nel periodo considerato e la somma delle ore allievo di tutti i corsi rispondenti ai requisiti indicati nella userform.
Spero di essere stato chiaro, nella mia mente è tutto lineare ma non so proprio da dove iniziare. Help me please!!!!

[Anthony47]

nella mia mente è tutto lineare ma non so proprio da dove iniziare. Help me please!!!!

Tutto dipende dalla tua attuale conoscenza del vba: minima, mediocre, decorosa, soddisfacente, etc?

Ciao, ti aspettiamo.

[ricky53]

Ciao,
prima legge quanto scritto da Anthony.

Io sono intervenuto suggerendoti: potresti ottenere la stampa anche senza una userform ma con una/due colonne di appogio ed applicando dei filtri ...

Consiglio: riorganizzando i dati (una riga per mese invece di una colonna per mese e ...) ed utilizzando una tabella PIVOT potresti avere quanto hai scritto ...

Ciao


P.S.: come mai hai scelto di utilizzare una userform ?

[xaba]

@ Anthony47
La mia conoscenza di vba è alquanto mediocre ma sono un tipo che si applica...

@ ricky53
So che potrei ottenere il risultato con un'altra organizzazione dei dati e con l'utilizzo dei filtri ma purtroppo devo fare i conti con i miei colleghi che non conoscono molto bene excel. Devo quindi ottenere una procedura molto automatizzata che sia semplice e non lasci margini di errore.

[Avatar3]

Potresti fare un esempio pratico?

es. : Con importo 100 euro
e scelta gennaio (mese)
e Bari (città)
quale risultato vorresti estrarre?

[xaba]

Esempio di risultato:
https://rapidshare.com/files/3178636500 ... ratico.xls

Per esempio, selezionando nella userform BARI e GENNAIO e immettendo l'importo € 100,00 , la procedura dovrebbe darmi il risultato nell'esempio. In pratica seleziona solo i corsi fatti a BARI, seleziona solo le ore svolte a GENNAIO e ne fa la somma, calcola la percentuale di incidenza mettendo a rapporto il numero di ore svolte di ciascun corso con la somma prima calcolata, moltiplica la percentuale di incidenza per l'importo immesso (€ 100,00), per ciascun corso mi da l'importo di incidenza.

[Avatar3]

Chierai il foglio Form "Maschera"
Crei un nuovo foglio che chiamerai "Risultato"
Inserisci in un modulo questa macro

Codice: Seleziona tutto

Sub CompilaTab()
    Dim Ws1 As Worksheet
    Dim Ws2 As Worksheet
    Dim Ws3 As Worksheet
    Dim E As Integer: Dim J As Integer: Dim R As Integer

Application.ScreenUpdating = False
Application.Calculation = xlManual

    Set Ws1 = Sheets("Maschera")
    Set Ws2 = Sheets("2011")
    Set Ws3 = Sheets("Risultato")
    Ws3.Select
    Ws3.Cells.Clear
    Ws2.Columns("A:P").Copy Destination:=Ws3.Columns("A:A")
    Ws3.Range("A1:N1").UnMerge
For RM = 8 To 19
    If Ws1.Range("H" & RM) <> "" Then
        Mese = Ws1.Range("I" & RM).Value
        GoTo SaltaRM
    End If
Next RM
SaltaRM:
For RC = 8 To 12
    If Ws1.Range("J" & RC) <> "" Then
        Citta = Ws1.Range("K" & RC).Value
        Citta = Mid(Citta, 1, 2)
        GoTo SaltaRC
    End If
Next RC
SaltaRC:
For CC = 14 To 3 Step -1
If Ws3.Cells(2, CC).Value <> Mese Then
Columns(CC).Delete Shift:=xlToLeft
End If
Next CC
UR3 = Ws3.Range("A" & Rows.Count).End(xlUp).Row
For RR = UR3 To 3 Step -1
If Ws3.Range("B" & RR).Value <> Citta Then Rows(RR & ":" & RR).Delete Shift:=xlUp
Next RR
Calculate
Ws3.Range("F2").Value = Ws1.Range("C7").Value
URS = Ws3.Range("E" & Rows.Count).End(xlUp).Row
For RRS = 3 To URS
Ws3.Range("F" & RRS).Value = Ws3.Range("F2").Value * Ws3.Range("E" & RRS).Value
Next RRS
       
Ws3.Range("F3:F" & URS).NumberFormat = "0.00"
Ws3.Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub



Nel Codice del foglio Maschera questo codice

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckAreaM = "H8:H19"
CheckAreaC = "J8:J12"
If Not Application.Intersect(ActiveCell, Range(CheckAreaM)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then GoTo Citta
    Application.EnableEvents = False
    Range(CheckAreaM).ClearContents
    If Selection.Value <> 0 Then
        Selection.ClearContents
    Else
        Selection.Value = 1
    End If
End If
Application.EnableEvents = True
Citta:
If Not Application.Intersect(ActiveCell, Range(CheckAreaC)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
    Application.EnableEvents = False
    Range(CheckAreaC).ClearContents
    If Selection.Value <> 0 Then
        Selection.ClearContents
    Else
        Selection.Value = 1
    End If
End If
Application.EnableEvents = True
End Sub


Ma Forse è meglio che allego anche il file
https://rapidshare.com/files/2356865577/ELENCO_CORSI3.xls

[xaba]

Prima di tutto ti ringrazio infinitamente per aver dedicato tempo e risorse a questo problema.

è un codice complicatissimo ma adesso mi metto a studiarlo......
C'è infatti un particolare che non ho spiegato: ci deve essere la possibilità di fare selezioni multiple nella maschera, fino al caso limite di poter considerare tutti i mesi e tutte le sedi.

[Avatar3]

In teoria, si (e forse anche in pratica) ma...
ammettendo di selezionare tutti i mesi e tutte le città ti ritroveresti un foglio simile ai dati origine con le incidenze identiche
oppure bisogna pensare di creare un foglio per ogni città, e in caso di più mesi?
Invia uno screenshot di come vorresti i dati output in caso di due o tre mesi e un paio di città con relativo importo.

[xaba]

ammettendo di selezionare tutti i mesi e tutte le città ti ritroveresti un foglio simile ai dati origine con le incidenze identiche

E' vero, selezionando tutti i mesi e tutte le sedi avrei un foglio simile ai dati origine ma questo sarebbe un caso limite.
Allego un file con due esempi di risultato, il primo selezionando due mesi e tutte le sedi, il secondo selezionando tre mesi e una sola sede.
https://rapidshare.com/files/3368253778 ... ultato.xls

[Avatar3]

Sostituisci la macro nel modulo con questa

Codice: Seleziona tutto

Sub CompilaTab()
    Dim Ws1 As Worksheet
    Dim Ws2 As Worksheet
    Dim Ws3 As Worksheet
    Dim E As Integer: Dim J As Integer: Dim R As Integer
    Dim MeseV(12) As String
    Dim CittaV(5) As String
Application.ScreenUpdating = False
Application.Calculation = xlManual

    Set Ws1 = Sheets("Maschera")
    Set Ws2 = Sheets("2011")
    Set Ws3 = Sheets("Risultato")
    Ws3.Select
    Ws3.Cells.Clear
    Ws2.Columns("A:P").Copy Destination:=Ws3.Columns("A:A")
    Ws3.Range("A1:N1").UnMerge
ContaM = 0
For RM = 8 To 19
    If Ws1.Range("H" & RM) <> "" Then
    ContaM = ContaM + 1
        MeseV(ContaM) = Ws1.Range("I" & RM).Value
    End If
Next RM

ContaC = 0
For RC = 8 To 12
    If Ws1.Range("J" & RC) <> "" Then
    ContaC = ContaC + 1
        Citta = Ws1.Range("K" & RC).Value
        CittaV(ContaC) = Mid(Citta, 1, 2)
    End If
Next RC

For CC = 14 To 3 Step -1
For CMe = 1 To ContaM
If Ws3.Cells(2, CC).Value = MeseV(CMe) Then
GoTo SaltaM
End If
Next CMe
Columns(CC).Delete Shift:=xlToLeft
SaltaM:
Next CC

UR3 = Ws3.Range("A" & Rows.Count).End(xlUp).Row
For RR = UR3 To 3 Step -1
For CA = 1 To ContaC
If Ws3.Range("B" & RR).Value = CittaV(CA) Then
GoTo SaltaC
End If
Next CA
Rows(RR & ":" & RR).Delete Shift:=xlUp
SaltaC:
Next RR

Calculate
UC = Ws3.Range("IV2").End(xlToLeft).Column + 1
Ws3.Cells(2, UC).Value = Ws1.Range("C7").Value
URS = Ws3.Cells(Rows.Count, UC - 1).End(xlUp).Row
For RRS = 3 To URS
Ws3.Cells(RRS, UC).Value = Ws3.Cells(2, UC).Value * Ws3.Cells(RRS, UC - 1).Value
Next RRS
       
Ws3.Range(Cells(3, UC), Cells(URS, UC)).NumberFormat = "0.00"
Ws3.Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Sostituisci la macro che trovi nel foglio Maschera con questa

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckAreaM = "H8:H19"
CheckAreaC = "J8:J12"
If Not Application.Intersect(ActiveCell, Range(CheckAreaM)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then GoTo Citta
    Application.EnableEvents = False
    If Selection.Value <> 0 Then
        Selection.ClearContents
    Else
        Selection.Value = 1
    End If
End If
Application.EnableEvents = True
Citta:
If Not Application.Intersect(ActiveCell, Range(CheckAreaC)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
    Application.EnableEvents = False
    If Selection.Value <> 0 Then
        Selection.ClearContents
    Else
        Selection.Value = 1
    End If
End If
Application.EnableEvents = True
End Sub


In caso di problemi scarica questo file
https://rapidshare.com/files/727071322/ELENCO_CORSI4.xls

[xaba]

Sembra funzionare tutto alla perfezione. Adesso faccio una serie di test e personalizzazioni e poi ti faccio sapere.
Grazie ancora tantissimo

[Avatar3]

[xaba]

Ho provato ad aggiungere una città all'elenco e, anche se inconsapevolmente, ci sono riuscito capendo che la sigla nel foglio 2011 deve essere di due lettere.
Ho personalizzato il nome dei progetti inserendo quelli reali e, rispettando il layout della tabella nel foglio 2011, non ci sono stati problemi.
Solo una domanda. Per modificare la formattazione del foglio Risultato dove devo intervenire?

[Avatar3]

Avrai notato che le colonne da A a P sono come le hai nel foglio 2011
pertanto se vuoi avere una formattazione diversa di queste colonne dovrai modificarla nel foglio 2011
mentre se vuoi cambiare la formattazione della colonna Euro con le sue percentuali bisogna aggiungere il codice di formattazione in quanto questa colonna è variabile (dipende dal numero di mesi che estrai ogni volta)
pertanto ti consiglio di registrare una macro che ti formatta questa colonna (esempio fondo verde per J3 nel caso che J sia la colonna della somma)
e aggiungerla alla fine della macro come ho fatto per la formattazione dei numeri a due cifre decimali

Codice: Seleziona tutto

Ws3.Range(Cells(3, UC), Cells(URS, UC)).NumberFormat = "0.00"


solo che nel tuo caso avrà .Interior.Color = x
se non è chiaro invia uno screenshot della formattazione foglio Risultati

[xaba]

Ok, perfetto, ho capito dove inserire le formattazioni della colonna.
Sto cercando di capire un pò il codice ma già qui non ci capisco più niente...

ContaM = 0
For RM = 8 To 19
If Ws1.Range("H" & RM) <> "" Then
ContaM = ContaM + 1
MeseV(ContaM) = Ws1.Range("I" & RM).Value
End If
Next RM

M è una variabile? Dove la definisci?

[Avatar3]

la variabile, in questo caso, vettore è definita all'inizio della macro

Codice: Seleziona tutto

   Dim MeseV(12) As String

in pratica prevedo tutti i dodici mesi
poi però non sapendo quanti mesi sceglierai creo un contatore

Codice: Seleziona tutto

For RM = 8 To 19
If Ws1.Range("H" & RM) <> "" Then
ContaM = ContaM + 1


dove Ws1 è il foglio maschera, la colonna H è la colonna con la spunta sul mese
se non c'è non lo conta
se c'è il contatore aumenta di 1
e in questo caso faccio assumere al vettore mese il

Codice: Seleziona tutto

MeseV(ContaM) = Ws1.Range("I" & RM).Value

quindi il MeseV(1) sarà = al valore della cella stessa riga ma nella colonna I esempio Febbraio (se gennaio non era spuntato)
etc etc