Macro mediasepiù

Hai un problema con Excel?

Nuova discussione

Macro media.se.più
di Andreadr89 (utente non iscritto) data: 09/04/2014 21:55:13
Buonasera ragazzi,
non ho molta dimestichezza con vba quindi abbiate un po' di pazienza .
Vi spiego il problema.

sul foglio1 ho una riga di date e una colonna di 100 nomi. Per ogni nome ho un numero e corrispondente a una data. Perciò ho una serie di numeri per ogni nome.

sul foglio 2 ho una colonna di 20 nomi nella prima colonna, una data di inizio nella seconda e una data di fine nella terza.

il mio scopo è andare a calcolare la media solamente all'interno delle date indicate nel secondo foglio.

Qualche idea?
di lepat (utente non iscritto) data: 10/04/2014 05:52:08
allega un file di esempio con anche il risultato desiderato
allegato
di AndreaDr89 (utente non iscritto) data: 10/04/2014 08:06:53
Ho allegato un file con un esempio. Quello che dovrei trovare è la media tra i due intervalli.

di lepat (utente non iscritto) data: 10/04/2014 09:31:52
controlla i nomi, alcuni hanno uno spazio finale

Sub a()
Set sh1 = Sheets(1)
LR1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row
LC1 = sh1.Cells(12, Cells.Columns.Count).End(xlToLeft).Column
LR2 = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
With Sheets(2)
  For r = 5 To LR2
    nome = .Cells(r, "A")
    inizio = .Cells(r, "B")
    fine = .Cells(r, "C")
    
    For r1 = 13 To LR1
      If sh1.Cells(r1, "B") = nome Then
        For c = 1 To LC1
          Data1 = sh1.Cells(12, c)
          If Data1 >= inizio And Data1 <= fine Then
            somma1 = somma1 + sh1.Cells(r1, c)
            n = n + 1
          End If
        Next
        media1 = somma1 / n
        n = 0: somma1 = 0
        .Cells(r, "D") = media1
      End If
    Next
  Next
End With
End Sub

di AndreaDr89 (utente non iscritto) data: 10/04/2014 10:11:58
Ti ringrazio anticipatamente anche solo per averci perso tempo.

Appena ho la possibilità la provo ti faccio sapere.

ancora grazie!
di Andrear89 (utente non iscritto) data: 10/04/2014 20:05:09
la macro gira ma c'è un problema perché non mi calcola l'intervallo intermedio ossia fa la media quando è compreso l'intervallo l'inizio o la fine
in poche parole non mi calcola la media nel rigo 5 e nel rigo 8
di lepat (utente non iscritto) data: 10/04/2014 20:20:01
te l'ho detto subito all'inizio "controlla i nomi, alcuni hanno uno spazio finale".
Se i nomi non corrispondono .......
di AndreaDr89 (utente non iscritto) data: 10/04/2014 20:46:07
si i nomi infatti li ho sistemati.

il problema è che o mi parte da un punto intermedio e arriva alla data fine o mi parte dall'inizio e arriva a un punto intermedio.

Non riesce a calcolare da punto intermedio a punto intermedio.

Sai per caso come risolvere questa cosa?
di lepat (utente non iscritto) data: 10/04/2014 20:55:30
a me funziona tutto, stai provando la macro su un altro file ?
di AndreaDr89 (utente non iscritto) data: 10/04/2014 20:59:08
no sempre sullo stesso.
Ma anche sulla 5d e sulla 8d t viene la media?
di AndreaDr89 (utente non iscritto) data: 10/04/2014 22:20:52
Puoi per favore scrivermi il codice che gira completamente?

Scusami per l'insistenza ma è veramente importante e sono veramente poco pratico
di AndreaDr89 (utente non iscritto) data: 10/04/2014 23:29:02
Scusami,
Sbagliavo io, sei veramente forte!!

Speriamo solo che lo riesca a far funzionare anche all'interno di un altro file un po' più complesso

Grazie ancora infinitamente
di lepat (utente non iscritto) data: 11/04/2014 07:41:18
se non funziona basta allegare il file definitivo

di AndreaDr89 (utente non iscritto) data: 12/04/2014 11:56:59
Ciao come t dicevo alcuni giorni fa non riesco a implementare il codice su un altro fil. Quello che t allegherò è solamente una parte perché sarebbe veramente troppo grande il tutto. Ti allego anche il codice da me modificato. Inoltre volevo chiederti se era possibile mettere nella colonna successiva alla media la varianza. Diventerebbe troppo complicato?

Grazie ancora per la disponibilità

Sub ADR()

Set sh1 = Sheets(6)
LR1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
LC1 = sh1.Cells(2, Cells.Columns.Count).End(xlToLeft).Column
LR2 = Sheets(8).Cells(Rows.Count, "A").End(xlUp).Row
With Sheets(8)
  For r = 2 To LR2
    nome = .Cells(r, "A")
    inizio = .Cells(r, "C")
    fine = .Cells(r, "D")
    
    For r1 = 2 To LR1
      If sh1.Cells(r1, "A") = nome Then
        For c = 1 To LC1
          Data1 = sh1.Cells(1, c)
          If Data1 >= inizio And Data1 <= fine Then
            somma1 = somma1 + sh1.Cells(r1, c)
            n = n + 1
          End If
        Next
        
        media1 = somma1 / n
        n = 0: somma1 = 0
        .Cells(r, "E") = media1
      End If
    Next
  Next
End With
End Sub

di AndreaDr89 (utente non iscritto) data: 12/04/2014 12:02:37
Purtroppo ho dovuto cancellare qualche foglio perché era troppo pesante quindi il nuovo codice diventa così

Sub ADR()

Set sh1 = Sheets(4)
LR1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
LC1 = sh1.Cells(2, Cells.Columns.Count).End(xlToLeft).Column
LR2 = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
With Sheets(3)
  For r = 2 To LR2
    nome = .Cells(r, "A")
    inizio = .Cells(r, "C")
    fine = .Cells(r, "D")
    
    For r1 = 2 To LR1
      If sh1.Cells(r1, "A") = nome Then
        For c = 1 To LC1
          Data1 = sh1.Cells(1, c)
          If Data1 >= inizio And Data1 <= fine Then
            somma1 = somma1 + sh1.Cells(r1, c)
            n = n + 1
          End If
        Next
        
        media1 = somma1 / n
        n = 0: somma1 = 0
        .Cells(r, "E") = media1

di lepat (utente non iscritto) data: 12/04/2014 12:39:04
non capisco:
1) perché alleghi file senza macro
2) il foglio 3 è pieno di errori
di AndreaDr89 (utente non iscritto) data: 12/04/2014 12:43:42
perché pieno di errori?

ho applicato la stessa formula per tutti. La macro l'ho scritta sotto almeno semmai potevi fare copia e incolla.
di Andreadr89 (utente non iscritto) data: 12/04/2014 14:05:48
Posso aiutarti in qualche modo a correggere gli errori?

di Rafafele_53 (utente non iscritto) data: 12/04/2014 16:04:51
Non so se ho capito bene, di sicuro non ho capito il titolo "media.se.più"
Premessa credo che gli #NA siano dati non acquisiti.
Che le date in Up siano tutte date di fine mese
Che Tu scriva le date in final in modo corretto da fine-mese a fine-mese (qui ho aggiunto una variante che se trova una data diversa da fine mese la calcola come fine mese)

Vedendo l'allegato 2 mi sembra che sul foglio "final" desideri solo la media (tra le date tra di "UP")
A me risultano altri valori, pero se metto =MEDIA(UP!IX4:JV4) è corretto.
La Varianza non so cosa sia.

Option Explicit
Sub ADR()
Dim sh1 As Worksheet: Set sh1 = Worksheets("UP") ' da cambiare casomai
Dim sh2 As Worksheet: Set sh2 = Worksheets("FINAL") ' da cambiare casomai
Dim LR1 As Long, LR2 As Long, LC1 As Long, LC2 As Long, X As Long, Y As Long, W As Long
Dim Area1 As Range, Area2 As Range, RR As Object, CC1 As Object, CC2 As Object, R As Long, C1 As Long, C2 As Long
Dim Nome As String, Inizio As Date, Fine As Date, Data1 As Date, UltimoGiorno As Date, Q As Range
Dim Media As Double, Somma As Double, N As Long

LR1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
LC1 = sh1.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
LR2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row
Set Area1 = sh1.Range("A1:A" & LR1)
Set Area2 = sh1.Range(sh1.Cells(1, 1), sh1.Cells(1, LC1))

With sh2
  For X = 2 To LR2
    Nome = .Cells(X, "A")
    Inizio = .Cells(X, "C")
    Inizio = DateSerial(Year(Inizio), Month(Inizio) + 1, 0)
    Fine = .Cells(X, "D")
    Fine = DateSerial(Year(Fine), Month(Fine) + 1, 0)
    Set RR = Area1.Find(Nome, LookIn:=xlValues, LookAt:=xlWhole)
        If RR Is Nothing Then
            MsgBox "nessuna corrispondenza"
        Else
            R = RR.Row
        End If
     Set CC1 = Area2.Find(Inizio, LookIn:=xlValues, LookAt:=xlWhole)
        If Not CC1 Is Nothing Then
            C1 = CC1.Column
        End If
     Set CC2 = Area2.Find(Fine, LookIn:=xlValues, LookAt:=xlWhole)
        If Not CC2 Is Nothing Then
            C2 = CC2.Column
        End If
    
    For Y = C1 To C2
        If sh1.Cells(R, Y) = "#NA" Then Exit For
            Somma = Somma + sh1.Cells(R, Y)
            N = N + 1
    Next Y
        If Somma > 0 Then
            Media = Somma / N
            N = 0: Somma = 0
            .Cells(X, "E") = Media
        Else
            .Cells(X, "E") = "Celle in Errore"
        End If
  Next X
End With
Set Area1 = Nothing
Set Area2 = Nothing
Set sh1 = Nothing
Set sh2 = Nothing
End Sub

di Andreadr89 (utente non iscritto) data: 12/04/2014 16:11:42
il titolo è relativo al fatto che credevo fosse necessario utilizzare quella funzione.
La varianza è la media degli scostante di ogni singolo elemento dal valore medio al quadrato.

Adesso provo subito la funzione e t faccio sapere.
grazie per l'interessamento
di Andreadr89 (utente non iscritto) data: 12/04/2014 16:17:57
Mi da il bug nella linea del #Na

di Raffaele_53 (utente non iscritto) data: 12/04/2014 16:27:30
Hai incollato il codice in un Modulo? Hai salvato come XLSM?
C'è scritto #NA in quelle celle oppure c'è scritto altro?

Modifica la parte finale con questo codice che fa una verifica alla MEDIA di quanti errori ci sono tra le date.

    Next Y
        If N = (C2 - C1) + 1 Then
            Media = Somma / N
            .Cells(X, "E") = Media
            N = 0: Somma = 0
        Else
            .Cells(X, "E") = Media & "  Alcune Celle in Errore"
        End If
  Next X
  MsgBox "Fatto"
End With

di AndreaDr89 (utente non iscritto) data: 12/04/2014 16:35:02
non me lo fa salvare il xlsm, quindi è salvato in xlsx.
c'e scritto #Value! , ma anche cambiando la denominazione mi da comunque errore
di Raffaele_53 (utente non iscritto) data: 12/04/2014 17:00:59
>>>non me lo fa salvare il xlsm ???
>>>c'e scritto #Value ???
Ti ho allegato il files
di Andreadr89 (utente non iscritto) data: 12/04/2014 17:18:22
A me non girava perché la devo far girare sul RETURN_UP e quindi non mi legge #value! anche cambiandoli. Mentre nella macro che mi hai scritto il codice gira su UP dove ci sono i #NA. quindi continua a darmi lo stesso problema di prima
di Raffaele_53 (utente non iscritto) data: 12/04/2014 18:17:50
Cambia la riga --->If sh1.Cells(R, Y) = "#NA" Then Exit For in
If IsError(sh1.Cells(R, Y)) Then Exit For
di Andreadr89 (utente non iscritto) data: 12/04/2014 18:37:30
Non so perché ancora non mi riesce a funzionare. Ti giuro sto impazzendo. Mi dice che non riesce a trovare i dati per quella riga
di Raffaele_53 (utente non iscritto) data: 12/04/2014 19:40:20
Puoi spostare il files con la macro inserita?
Con solo due fogli RETURN_UP e FINAL
di Andreadr89 (utente non iscritto) data: 12/04/2014 21:03:43
Si, potrei farlo. Hai qualche idea?
A me serve solo generare una colonna di medie e una di varianze (ma poi a questa ci penserò). Tanto poi le esporterò in Stata. Purtroppo in vba non so minimamente programmare
di Raffaele_53 (utente non iscritto) data: 12/04/2014 22:29:12
>>>Non so perché ancora non mi riesce a funzionare.
>>>Si, potrei farlo.

Se desideri che visualizzi dove sia l'errore, perché a me funziona bene

di Andreadr89 (utente non iscritto) data: 12/04/2014 23:01:08
Inutile pensarci troppo, aveva ragione lepat fin dall'inizio. La macro era quella il problema principale è che mi si sono sfalsati i dati e vi assicuro non per colpa mia. Mi hanno telefonato adesso.

Ti ringrazio anche a te, Rafafele_53, sei stato veramente bravo e disponibile. Anche solo leggendo i vostri commenti ho potuto imparare molto!

Se possibile vi vorrei chiedere l'ultimo favore e poi giuro che chiudo la conversazione. Alla colonna a fianco alle media dovrei scrivere la varianza che sarebbe la somma degli scostamenti delle varie osservazioni dalla media. Questa differenza al quadrato e poi la divido per n.

Sotto ho scritto il mio codice che purtroppo non gira ma almeno può darvi un idea di cosa intendo. Potete applicarlo anche al primo allegato

Sub a()
Set sh1 = Sheets(1)
LR1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row
LC1 = sh1.Cells(12, Cells.Columns.Count).End(xlToLeft).Column
LR2 = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
With Sheets(2)
  For r = 5 To LR2
    nome = .Cells(r, "A")
    inizio = .Cells(r, "B")
    fine = .Cells(r, "C")
    
    For r1 = 13 To LR1
      If sh1.Cells(r1, "B") = nome Then
        For c = 1 To LC1
          Data1 = sh1.Cells(12, c)
          If Data1 >= inizio And Data1 <= fine Then
            somma1 = somma1 + sh1.Cells(r1, c)
            n = n + 1
          End If
        Next
        media1 = somma1 / n
        n = 0: somma1 = 0
        .Cells(r, "D") = media1
    For c = 1 To LC1
          Data1 = sh1.Cells(12, c)
          If Data1 >= inizio And Data1 <= fine Then
            varianza1 = sh1.Cells(r1, c) - media1
            n = n + 1
        dev1 = varianza1 / n
         n = 0: somma1 = 0
        .Cells(r, "E") = dev1
          End If
      Next

End Sub

di Raffaele_53 (utente non iscritto) data: 13/04/2014 00:36:39
Nel 1° allegato il codice riga "andreasenza spazio finale" elabora 5 date
03/10/1989 04/10/1989 05/10/1989 06/10/1989 07/10/1989 e sotto ci sono i rispettivi valori
6 7 7 8 8
Fammi la varianza su quei 5 numeri?
di Andreadr89 (utente non iscritto) data: 13/04/2014 00:49:35
Si esatto. I nomi con lo spazio li ho corretto successivamente comunque il senso e' quello. Sarebbe perfetto se fosse un integrazione del codice che ho pubblicato. Grazie ancora

di Raffaele_53 (utente non iscritto) data: 13/04/2014 00:51:35
Potevi fare la varianza su quei 5 numeri (che non so cosa sia)

Sub a()
Set sh1 = Sheets(1)
LR1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row
LC1 = sh1.Cells(12, Cells.Columns.Count).End(xlToLeft).Column
LR2 = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
With Sheets(2)
  For r = 5 To LR2
    nome = .Cells(r, "A")
    inizio = .Cells(r, "B")
    fine = .Cells(r, "C")
    For r1 = 13 To LR1
      If sh1.Cells(r1, "B") = nome Then
            For c = 1 To LC1
                Data1 = sh1.Cells(12, c)
                    If Data1 >= inizio And Data1 <= fine Then
                        somma1 = somma1 + sh1.Cells(r1, c)
                        n = n + 1
                    End If
            Next c
            media1 = somma1 / n
            varianza1 = ((somma1 - media1) * (somma1 - media1)) / n
            n = 0: somma1 = 0
            .Cells(r, "D") = media1
            .Cells(r, "E") = varianza1
       End If
    Next r1
  Next r
End With
End Sub

di AndreaDr89 (utente non iscritto) data: 13/04/2014 01:06:08
ok il procedimento è perfetto pero la formula no. Probabilmente mi sono spiegato male. La formula sarebbe

var=(1/n)*Sommatoria (Xi-media)elevato al quadrato. xi rappresenta il fatto che deve assumere tutti i valori all'interno dell'intervallo
ad esempio Marco= valori 2 3 4 5 6 media 4

la varianza sarà data da 1/n*[(2-4)^2+(3-4)^2+(4-4)^2+(5-4)^2+(6-4)^2]

di Raffaele_53 (utente non iscritto) data: 13/04/2014 12:15:46
>>>1/n*[(2-4)^2+(3-4)^2+(4-4)^2+(5-4)^2+(6-4)^2]

Non sono in grado di capirla, posso intendere che ad ogni valore di cella togli la media1 e moltiplichi al quadrato.
Alla fine di questo dividi la varianza per n volte .......e forse lo moltiplichi per se stesso?

Sub a()
Set sh1 = Sheets(1)
LR1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row
LC1 = sh1.Cells(12, Cells.Columns.Count).End(xlToLeft).Column
LR2 = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
With Sheets(2)
  For r = 5 To LR2
    nome = .Cells(r, "A")
    inizio = .Cells(r, "B")
    fine = .Cells(r, "C")
    For r1 = 13 To LR1
      If sh1.Cells(r1, "B") = nome Then
            For c = 1 To LC1 '(ciclo for "C" per la media)
                Data1 = sh1.Cells(12, c)
                    If Data1 >= inizio And Data1 <= fine Then
                        somma1 = somma1 + sh1.Cells(r1, c)
                        n = n + 1
                    End If
            Next c
            media1 = somma1 / n
            .Cells(r, "D") = media1
            For c = 1 To LC1 '(ciclo for "C" per la varianza1)
                Data1 = sh1.Cells(12, c)
                    If Data1 >= inizio And Data1 <= fine Then
                        varianza1 = varianza1 + ((sh1.Cells(r1, c) - media1) ^ 2)
                    End If
            Next c
            'varianza1 = (varianza1 / n)' forse è cosi
            varianza1 = (varianza1 / n) * varianza1 'mi sembra che devi moltiplicarlo
            .Cells(r, "E") = varianza1
            n = 0: somma1 = 0
       End If
    Next r1
  Next r
End With
End Sub

di AndreaDr89 (utente non iscritto) data: 13/04/2014 12:27:22
Dovrei aver risolto. Ti scrivo il codice se sei interessato a come risolverlo e a capire cose intendevo. Ho comunque costruito una nuova macro.
Grazie sei stato veramente di grande aiuto e gentilissimo.

Ti ringrazio molto.

Sub v()

Set sh1 = Sheets(1)
LR1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row
LC1 = sh1.Cells(12, Cells.Columns.Count).End(xlToLeft).Column
LR2 = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
With Sheets(2)
  For r = 5 To LR2
    nome = .Cells(r, "A")
    inizio = .Cells(r, "B")
    fine = .Cells(r, "C")
    media1 = .Cells(r, "D")
    For r1 = 13 To LR1
      If sh1.Cells(r1, "B") = nome Then
            For c = 1 To LC1
                Data1 = sh1.Cells(12, c)
                    If Data1 >= inizio And Data1 <= fine Then
                        varianza1 = varianza1 + (sh1.Cells(r1, c) - media1) * (sh1.Cells(r1, c) - media1)
                        n = n + 1
                    End If
            Next c
            dev1 = varianza1 / n
            
            n = 0: varianza1 = 0
            
            .Cells(r, "E") = dev1
       End If
    Next r1
  Next r
End With
End Sub

di Raffaele_53 (utente non iscritto) data: 13/04/2014 13:56:58
Ho capito la formula della varianza.

Volevo solo sottolineare il dover dare alle VARIANTI le giuste dichiarazioni.
Allego un files per farTi visualizzare alcuni errori di calcolo.

Il primo codice da me proposto comporta di tutte le varianti.
Che io sappia ad un numero decimale si deve dare la Variante = Double oppure i calcoli sono errati

Ps in modulo 4 c'è il primo codice modificato (non provato)
di Andreadr89 (utente non iscritto) data: 13/04/2014 14:03:26
Grazie!

Vuoi Approfondire?