Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

[EXCEL] Trovare quante volte compaiono determinate n-uple

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

[EXCEL] Trovare quante volte compaiono determinate n-uple

Postdi Syntony » 09/08/12 10:13

Salve,
ho un file in cui sono presenti due colonne tra le altre: codice articolo e id dell'ordine in cui è stato acquistato, ovviamente gli articoli possono comparire in diversi ordini.
Di seguito un esempio del file che ho e del file che vorrei avere.

https://rapidshare.com/files/1967989536/Esempio.xlsx

In pratica vorrei calcolare il numero delle volte in cui 2 prodotti (o 3, o 4) sono stati acquistati insieme (cioè hanno lo stesso id ordine)
Syntony
Newbie
 
Post: 4
Iscritto il: 09/08/12 09:49

Sponsor
 

Re: [EXCEL] Trovare quante volte compaiono determinate n-upl

Postdi Flash30005 » 09/08/12 11:12

Ciao Syntony e benvenuto nel Forum

Vorrei sapere se i dati inseriti nella colonna F del foglio "File di Input" sono presenti sin dall'origine oppure devi ricavarli?
Se sono presenti dall'origine dovresti avere anche le "combinazioni" per i gruppi di 3 articoli, quattro articoli etc.

Confermi?

Ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Trovare quante volte compaiono determinate n-upl

Postdi Syntony » 09/08/12 11:18

Ciao, purtroppo non li ho ma devo ricavarli, nell'esempio l'ho fatto a mano perchè sono pochi, ma in realtà essendo molti di più avrei bisogno di una funzione che faccia questa cosa.
Syntony
Newbie
 
Post: 4
Iscritto il: 09/08/12 09:49

Re: [EXCEL] Trovare quante volte compaiono determinate n-upl

Postdi Flash30005 » 09/08/12 11:23

C'è un limite al numero di gruppi articoli (combinazioni)?
possono andare oltre 4?
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Trovare quante volte compaiono determinate n-upl

Postdi Syntony » 09/08/12 11:26

Ci possono essere n articoli venduti nello stesso ordine (id ordine uguale), n può essere anche grande: 20, 30.

Mentre le combinazioni da ricercare probabilmente sono coppie, terne, quaterne e cinquine, oltre è poco probabile.
Syntony
Newbie
 
Post: 4
Iscritto il: 09/08/12 09:49

Re: [EXCEL] Trovare quante volte compaiono determinate n-upl

Postdi Flash30005 » 09/08/12 14:43

Sicuramente si può fare meglio
la considero molto spartana ma... funziona :)
Codice: Seleziona tutto
Public UR1A, N1, N2, N3, N4, N5, NCo, ContaC, IniR As Integer, Ws1, Ws2 As Worksheet
Sub CompilaTab()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Set Ws1 = Worksheets("File di Input")
Set Ws2 = Worksheets("FTab")
ContaC = 0
Ws1.Columns(11).ClearContents
UR1A = Ws1.Range("A" & Rows.Count).End(xlUp).Row
For RR1 = 2 To UR1A
EleA = Ws1.Range("A" & RR1)
UR1K = Ws1.Range("K" & Rows.Count).End(xlUp).Row + 1
For RR2 = 2 To UR1K
If Ws1.Range("K" & RR2).Value = EleA Then GoTo SaltaRR1
Next RR2
Ws1.Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).Value = EleA
SaltaRR1:
Next RR1
Ws1.Select
Ws1.Columns("K:K").Sort Key1:=Range("K2"), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
Ws1.Columns("A:B").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

NCo = Ws2.Range("B1").Value
UR1K = Ws1.Range("K" & Rows.Count).End(xlUp).Row
Ws2.Range("A5:B1000").ClearContents
For RCo1 = 2 To UR1K - (NCo - 1)
    N1 = Ws1.Range("K" & RCo1).Value
    For RCo2 = RCo1 + 1 To UR1K - (NCo - 2)
        N2 = Ws1.Range("K" & RCo2).Value
        If NCo = 2 Then
        ContaCo
            If ContaC > 0 Then
                Ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = N1 & ";" & N2
                Ws2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = ContaC
            End If
            ContaC = 0
            GoTo SaltaR2
        End If
        For RCo3 = RCo2 + 1 To UR1K - (NCo - 3)
            N3 = Ws1.Range("K" & RCo3).Value
            If NCo = 3 Then
            ContaCo
            If ContaC > 0 Then
                Ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = N1 & ";" & N2 & ";" & N3
                Ws2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = ContaC
            End If
            ContaC = 0
            GoTo SaltaR3
            End If
            For RCo4 = RCo3 + 1 To UR1K - (NCo - 4)
                N4 = Ws1.Range("K" & RCo4).Value
                If NCo = 4 Then
                    ContaCo
                    If ContaC > 0 Then
                        Ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = N1 & ";" & N2 & ";" & N3 & ";" & N4
                        Ws2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = ContaC
                    End If
                    ContaC = 0
                    GoTo SaltaR4
                End If
                For RCo5 = RCo4 + 1 To UR1K
                    N5 = Ws1.Range("K" & RCo5).Value
                    ContaCo
                    If ContaC > 0 Then
                        Ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = N1 & ";" & N2 & ";" & N3 & ";" & N4 & ";" & N5
                        Ws2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = ContaC
                    End If
                    ContaC = 0
                Next RCo5
SaltaR4:
            Next RCo4
SaltaR3:
        Next RCo3
SaltaR2:
    Next RCo2
Next RCo1
Ws1.Columns("A:B").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
Ws2.Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub ContaCo()
IniR = 2
    For RR1 = IniR To UR1A - (NCo - 1)
        IDN1 = Ws1.Range("B" & RR1).Value
        N1A = Ws1.Range("A" & RR1).Value
        For RR2 = RR1 + 1 To UR1A - (NCo - 2)
            N2A = Ws1.Range("A" & RR2).Value
            IDN2 = Ws1.Range("B" & RR2).Value
            If NCo = 2 Then
                If IDN1 = IDN2 And N1A = N1 And N2A = N2 Then
                    ContaC = ContaC + 1
                    IniR = RR2
                    GoTo SaltaRR1
                End If
            End If
            For RR3 = RR2 + 1 To UR1A - (NCo - 3)
                N3A = Ws1.Range("A" & RR3).Value
                IDN3 = Ws1.Range("B" & RR3).Value
                If NCo = 3 Then
                    If IDN1 = IDN2 And IDN1 = IDN3 And N1A = N1 And N2A = N2 And N3A = N3 Then
                        ContaC = ContaC + 1
                        IniR = RR3
                        GoTo SaltaRR1
                    End If
                End If
                For RR4 = RR3 + 1 To UR1A - (NCo - 4)
                    N4A = Ws1.Range("A" & RR4).Value
                    IDN4 = Ws1.Range("B" & RR4).Value
                    If NCo = 4 Then
                        If IDN1 = IDN2 And IDN1 = IDN3 And IDN1 = IDN4 And N1A = N1 And N2A = N2 And N3A = N3 And N4A = N4 Then
                            ContaC = ContaC + 1
                            IniR = RR4
                            GoTo SaltaRR1
                        End If
                    End If
                    For RR5 = RR4 + 1 To UR1A
                        N5A = Ws1.Range("A" & RR5).Value
                        IDN5 = Ws1.Range("B" & RR5).Value
                        If NCo = 5 Then
                            If IDN1 = IDN2 And IDN1 = IDN3 And IDN1 = IDN4 And IDN1 = IDN5 And N1A = N1 And N2A = N2 And N3A = N3 And N4A = N4 And N5A = N5 Then
                                ContaC = ContaC + 1
                                IniR = RR5
                                GoTo SaltaRR1
                            End If
                        End If
                    Next RR5
                Next RR4
            Next RR3
        Next RR2
SaltaRR1:
    Next RR1
End Sub

Rinomina il foglio output con nome "FTab"
Copia l'intera macro in un modulo e avvia solo la macro "CompilaTab" assegnando un pulsante, forma etc

oppure inserisci questo codice nel foglio "FTab"
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$1" Then Exit Sub
CompilaTab
End Sub


Fai sapere

Ciao

P.s. Fai attenzione perché utilizzo la colonna "K" del "Foglio1" per creare un elenco univoco che occorre alla macro stessa
pertanto se hai dei dati su quella colonna si deve modificare il riferimento nella macro
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: [EXCEL] Trovare quante volte compaiono determinate n-upl

Postdi Syntony » 09/08/12 15:15

Ciao,

innanzitutto grazie mille per la pronta risposta!

Ho provato a fare come dici ma non succede nulla, o meglio quando clicco sulla forma dove ho assegnato la macro vedo che sta compiendo qualche azione, ma il foglio FTab rimane solo con la forma scelta.
Mentre crea 5 lettere (a,b,c,d,e) nella colonna K del foglio 1.
Probabilmente sbaglio qualcosa, non sono molto dentro le macro, quindi probabilmente salto qualche passaggio fondamentale.

Ciao e grazie ancora!
Syntony
Newbie
 
Post: 4
Iscritto il: 09/08/12 09:49

Re: [EXCEL] Trovare quante volte compaiono determinate n-upl

Postdi Flash30005 » 09/08/12 17:18

Forse non hai copiate le variabili "Public" in testa al modulo
comunque prova questo file

Puoi anche eliminare il comando perché è sufficiente variare il valore in B1 del foglio "FTab"

ciao
Flash
Win7 + Office 2010 Ita
"Fotografica" al servizio dell'immagine

Ottime opportunità di lavoro (part-time o full-time) con guadagni immediati. Info in MP
Avatar utente
Flash30005
Moderatore
 
Post: 8460
Iscritto il: 27/09/07 11:44
Località: Roma +o-


Torna a Applicazioni Office Windows


Topic correlati a "[EXCEL] Trovare quante volte compaiono determinate n-uple":


Chi c’è in linea

Visitano il forum: Nessuno e 4 ospiti