Excel Forum

	Soluzioni Excel Domande e Risposte
		fare una media su sottogruppi di una colonna

Pagina precedente | 1 | Pagina successiva

Vota | Stampa | Notifica email

« Discussione Precedente | Lista | Discussione Successiva »

Autore

fare una media su sottogruppi di una colonna

Ultimo Aggiornamento: 01/05/2019 07:36

Marco Consumi

Post: 7

Registrato il: 25/11/2015

Utente Junior

office 2013

OFFLINE

26/03/2019 12:52

00#1

Ciao a tutti,
Ho un problema per me molto complesso, ma sono molto scarso in excel, quindi forse è semplice😀.

L'obiettivo è creare una routine che faccia in automatico quello che faccio a mano:
Scorro lungo una colonna di valori finché non incontro un valore che supera il precedente per 0.1. A quel punto prendo i valori trovati nella colonna e ne faccio la media mentre cerco nelle celle adiacenti a questo sottogruppo le celle con valori diversi da 0 e li allineo alla media e riparto.
In allegato un file di esempio
ciao
Marco

GiuseppeMN

Post: 3.336

Registrato il: 03/04/2013

Utente Master

Excel 2000 - 2013

OFFLINE

26/03/2019 19:05

00#2

Buon pomeriggio, Marco;
ho cercato di impostare il calcolo della "Media" in Colonna 13 con questo Codice VBA:

Option Explicit

Sub Media()
Application.ScreenUpdating = False
Dim NRc As Long, x As Long, RgI As Long, RgF As Long, Rg As Long
Dim Frm As String
    NRc = Range("M" & Rows.Count).End(xlUp).Row
        If NRc < 4 Then NRc = 4
            Range(Cells(4, 13), Cells(NRc, 19)).ClearContents
    NRc = Range("C" & Rows.Count).End(xlUp).Row
        RgI = 3
        Rg = 5
        For x = 3 To NRc
            If Cells(x + 1, 3) - Cells(x, 3) > 0.1 Then
                Frm = "=MEDIA($C" & RgI & ":$C" & x & ")"
                    Cells(Rg, 13).FormulaLocal = Frm
                Cells(Rg, 13).Copy
                    Cells(Rg, 13).PasteSpecial Paste:=xlPasteValues
                RgI = x + 1
                Rg = Rg + 2
            End If
        Next x
            Frm = "=MEDIA($C" & RgI & ":$C" & x & ")"
                Cells(Rg, 13).FormulaLocal = Frm
            Cells(Rg, 13).Copy
                Cells(Rg, 13).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
Application.ScreenUpdating = True
    Cells(5, 14).Select
End Sub

ma non credo di aver capito come interpretare i Valori in "A1 A2 A3 A4 A5 A6".

Potresti indicarmi la regola da utilizzare?

Grazie dell'attenzione che potrai dedicarmi.

Buona serata.

Giuseppe

Windows XP - Excel 2000
Windows 10 - Excel 2013

GiuseppeMN

Post: 3.337

Registrato il: 03/04/2013

Utente Master

Excel 2000 - 2013

OFFLINE

26/03/2019 19:35

00#3

Forse ho capito, i Valori in "A1 A2 A3 A4 A5 A6" sono Valori massimi.
Ho provato questo Codice VBA:

Option Explicit

Sub Media()
Application.ScreenUpdating = False
Dim NRc As Long, x As Long, RgI As Long, RgF As Long, Rg As Long
Dim Frm As String
    NRc = Range("M" & Rows.Count).End(xlUp).Row
        If NRc < 4 Then NRc = 4
            Range(Cells(4, 13), Cells(NRc, 19)).ClearContents
    NRc = Range("C" & Rows.Count).End(xlUp).Row
        RgI = 3
        Rg = 5
        For x = 3 To NRc
            If Cells(x + 1, 3) - Cells(x, 3) > 0.1 Then
                Frm = "=MEDIA($C" & RgI & ":$C" & x & ")"
                    Cells(Rg, 13).FormulaLocal = Frm
                        Cells(Rg, 13).Copy
                    Cells(Rg, 13).PasteSpecial Paste:=xlPasteValues
                    Cells(Rg, 14) = Application.WorksheetFunction.Max(Range("D" & RgI & ":D" & x))
                    Cells(Rg, 15) = Application.WorksheetFunction.Max(Range("E" & RgI & ":E" & x))
                    Cells(Rg, 16) = Application.WorksheetFunction.Max(Range("F" & RgI & ":F" & x))
                    Cells(Rg, 17) = Application.WorksheetFunction.Max(Range("G" & RgI & ":G" & x))
                    Cells(Rg, 18) = Application.WorksheetFunction.Max(Range("H" & RgI & ":H" & x))
                    Cells(Rg, 19) = Application.WorksheetFunction.Max(Range("I" & RgI & ":I" & x))
                RgI = x + 1
                Rg = Rg + 2
            End If
        Next x
            Frm = "=MEDIA($C" & RgI & ":$C" & x & ")"
                Cells(Rg, 13).FormulaLocal = Frm
                    Cells(Rg, 13).Copy
                        Cells(Rg, 13).PasteSpecial Paste:=xlPasteValues
                Cells(Rg, 14) = Application.WorksheetFunction.Max(Range("D" & RgI & ":D" & x))
                Cells(Rg, 15) = Application.WorksheetFunction.Max(Range("E" & RgI & ":E" & x))
                Cells(Rg, 16) = Application.WorksheetFunction.Max(Range("F" & RgI & ":F" & x))
                Cells(Rg, 17) = Application.WorksheetFunction.Max(Range("G" & RgI & ":G" & x))
                Cells(Rg, 18) = Application.WorksheetFunction.Max(Range("H" & RgI & ":H" & x))
                Cells(Rg, 19) = Application.WorksheetFunction.Max(Range("I" & RgI & ":I" & x))
    Application.CutCopyMode = False
Application.ScreenUpdating = True
    Cells(5, 14).Select
End Sub

Sembra funzionare; o mi sbaglio?

Buona serata.

Giuseppe

Windows XP - Excel 2000
Windows 10 - Excel 2013

Marco Consumi

Post: 7

Registrato il: 25/11/2015

Utente Junior

office 2013

OFFLINE

29/04/2019 17:49

10#4

Re:

Grande Giuseppe,
funziona perfettamente!!!! In realtà "A1 A2 A3 A4 A5 A6" sono i valori non zero.
Complimenti davvero mi hai risolto la vita. 👌👌👌👌👌👍👍👍👍
Grazie mille, un ultima cosa mi puoi consigliare qualche guida semplice per capire come scroivre e modificare i codici VBA?
grazie ancora
Marco

GiuseppeMN, 26/03/2019 19.35:

Forse ho capito, i Valori in "A1 A2 A3 A4 A5 A6" sono Valori massimi.
Ho provato questo Codice VBA:

Option Explicit

Sub Media()
Application.ScreenUpdating = False
Dim NRc As Long, x As Long, RgI As Long, RgF As Long, Rg As Long
Dim Frm As String
    NRc = Range("M" & Rows.Count).End(xlUp).Row
        If NRc < 4 Then NRc = 4
            Range(Cells(4, 13), Cells(NRc, 19)).ClearContents
    NRc = Range("C" & Rows.Count).End(xlUp).Row
        RgI = 3
        Rg = 5
        For x = 3 To NRc
            If Cells(x + 1, 3) - Cells(x, 3) > 0.1 Then
                Frm = "=MEDIA($C" & RgI & ":$C" & x & ")"
                    Cells(Rg, 13).FormulaLocal = Frm
                        Cells(Rg, 13).Copy
                    Cells(Rg, 13).PasteSpecial Paste:=xlPasteValues
                    Cells(Rg, 14) = Application.WorksheetFunction.Max(Range("D" & RgI & ":D" & x))
                    Cells(Rg, 15) = Application.WorksheetFunction.Max(Range("E" & RgI & ":E" & x))
                    Cells(Rg, 16) = Application.WorksheetFunction.Max(Range("F" & RgI & ":F" & x))
                    Cells(Rg, 17) = Application.WorksheetFunction.Max(Range("G" & RgI & ":G" & x))
                    Cells(Rg, 18) = Application.WorksheetFunction.Max(Range("H" & RgI & ":H" & x))
                    Cells(Rg, 19) = Application.WorksheetFunction.Max(Range("I" & RgI & ":I" & x))
                RgI = x + 1
                Rg = Rg + 2
            End If
        Next x
            Frm = "=MEDIA($C" & RgI & ":$C" & x & ")"
                Cells(Rg, 13).FormulaLocal = Frm
                    Cells(Rg, 13).Copy
                        Cells(Rg, 13).PasteSpecial Paste:=xlPasteValues
                Cells(Rg, 14) = Application.WorksheetFunction.Max(Range("D" & RgI & ":D" & x))
                Cells(Rg, 15) = Application.WorksheetFunction.Max(Range("E" & RgI & ":E" & x))
                Cells(Rg, 16) = Application.WorksheetFunction.Max(Range("F" & RgI & ":F" & x))
                Cells(Rg, 17) = Application.WorksheetFunction.Max(Range("G" & RgI & ":G" & x))
                Cells(Rg, 18) = Application.WorksheetFunction.Max(Range("H" & RgI & ":H" & x))
                Cells(Rg, 19) = Application.WorksheetFunction.Max(Range("I" & RgI & ":I" & x))
    Application.CutCopyMode = False
Application.ScreenUpdating = True
    Cells(5, 14).Select
End Sub

Sembra funzionare; o mi sbaglio?

Buona serata.

Giuseppe

GiuseppeMN

Post: 3.346

Registrato il: 03/04/2013

Utente Master

Excel 2000 - 2013

OFFLINE

29/04/2019 19:25

00#5

Buona sera, Marco:
grazie del tuo riscontro.

@Marco Consumi, scrive:

... mi puoi consigliare qualche guida semplice per capire come scroivre e modificare i codici VBA?

In rete trovi tutorial molto ben costruiti; ma posso dirti come ho iniziato io:
- Registratore di Macro, tanta fantasia e qualche visita in biblioteca per chiarire i dubbi.

Questo mi ha consentito di archiviare in un File moltissimi Codici VBA, più di 1.000 ordinati per argomento, per poi utilizzarli ad ogni necessità.
Inoltre ho archiviato altri 2.000 File con tutte le possibili soluzioni con Formule native Excel e Codici VBA, sempre ordinati per argomento.

In questi giorni sto seriamente pensando di raggruppare tutto in due libri ben distinti; non per scopi economici, eventuali quanto improbabili benefici andrebbero sicuramente a qualche ONLUS, ma per evitare di dover scrivere sulla mia epigrafe " ... e gli sembrò di aver vissuto invano."

A disposizione.

Buona serata.

Giuseppe

Windows XP - Excel 2000
Windows 10 - Excel 2013

Marco Consumi

Post: 8

Registrato il: 25/11/2015

Utente Junior

office 2013

OFFLINE

30/04/2019 17:31

00#6

Re:

Grazie mille, fammi sapere, se posso contribuirò volentieri.
ciao
Marco

In questi giorni sto seriamente pensando di raggruppare tutto in due libri ben distinti; non per scopi economici, eventuali quanto improbabili benefici andrebbero sicuramente a qualche ONLUS, ma per evitare di dover scrivere sulla mia epigrafe " ... e gli sembrò di aver vissuto invano."

GiuseppeMN

Post: 3.351

Registrato il: 03/04/2013

Utente Master

Excel 2000 - 2013

OFFLINE

01/05/2019 07:36

00#7

Buona giornata, Marco;
ho apprezzato moltissimo il tuo riscontro.
In segno di gratitudine sarei lito di fornirti la mia raccolta di Macro; se lo ritieni utile e opportuno, privatamente tramite "ffz", indicami la tua mail.

Sarà mia premura inviarti il mio File "MACROMAG.xls o MACROMAG.xlsm" e seguirti nelle modalità di utilizzo.

A disposizione.

Buon Lavoro.

Giuseppe

Windows XP - Excel 2000
Windows 10 - Excel 2013

Vota:

Pagina precedente | 1 | Pagina successiva

Nuova Discussione

Rispondi

Cerca nel forum

Cerca

nei titoli, nei messaggi, con Google

cerca discussioni con titolo simile

Tag discussione

colonna media

Discussioni Simili [vedi tutte]

fare una media su sottogruppi di una colonna

GiuseppeMN, 26/03/2019 19.35:

Anteprima