Pagina 1 di 2 12 UltimaUltima
Risultati da 1 a 30 di 36

Discussione: Contare abbinamenti in una matrice quadrata n x n



  1. #1
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1

    Contare abbinamenti in una matrice quadrata n x n

    Ciao a tutti!
    stavo facendo qualche progresso in VBA... quando mi sono imbattuto in un problemino apparentemente semplice ma che non sono riuscito ad impostare! :262:
    Ho una matrice quadrata, che può essere anche 100 x 100, fatta in questo modo:

    A B C D E
    A
    B
    C
    D
    E

    Dove - per prima riga e prima colonna - ho degli articoli univoci: la riga orizzontale è praticamente il trasposto della colonna verticale (A B C D E).
    Questo ordinamento serve a contare, all'interno della griglia che si viene a formare, quante volte, ad esempio, l'articolo D si combina con l'articolo A, B, C ed E in uno stesso ordine (dato che D con D è sicuro, perché si combina con se stesso).

    I valori vengono presi dal foglio 1, recante sole 2 colonne: quella degli ordini seriali, in cui sono richiesti gli articoli trattati, e gli articoli stessi - richiesti per ciascun seriale (naturalmente ci sono dei duplicati su ambo le colonne, deve essere così).

    Il problema è che la procedura che allego nel file di esempio, al click della macro mi riempie la matrice con soli zeri!
    Dove sbaglio? :1172:
    Ho notato che, peraltro, basterebbe contare solo l'area compresa all'interno di una delle 2 diagonali della matrice, dato che gli abbinamenti sono simmetrici.

    Chiedo aiuto!
    File Allegati File Allegati

  2. #2
    L'avatar di Gerardo Zuccalà
    Clicca e Apri
    Data Registrazione
    May 2015
    Località
    Milano, Italy
    Età
    49
    Messaggi
    4920
    Versione Office
    2013
    Likes ricevuti
    1117
    Likes dati
    1127
    Ciao Maurizio, giusto per capire, anche perchè con il VBA non potrei aiutarti, ma nella tabella incrociata dell' ultimo foglio, come faccio a sapere quante volte Es. D si incontra con F? da dove le prendo le informazioni? non mi sembra di aver visto da nessuna parte che determinati codici si incontrano, ed è forse per questo che il risultato è zero a quel punto la macro funziona bene

  3. #3

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4046
    Versione Office
    2013
    Likes ricevuti
    1239
    Likes dati
    931
    Ciao a tutti,
    anche io non ho capito il risultato atteso....
    Per come hai sistemato i dati, ogni articolo si combina 1 volta con tutti gli altri mentre nella diagonale dovresti avere dei 2. O no?

    Allega il file scrivendo manualmente il risultato atteso in modo da capire cosa ci possa essere di sbagliato nel codice.

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  4. #4
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1
    Ciao Gerardo!

    Se apri la finestra del codice, puoi notare che si dovrebbero tenere in considerazione gli ordini seriali che domandano quegli articoli: sapere, cioè, quante volte quegli articoli sono stati domandati - insieme - in uno stesso ordine (sul totale degli 8000 del foglio1: visivamente, lo vedi dal fatto che hai l'ordine duplicato e i due articoli presenti).

    Non so se sono riuscito a spiegarmi bene...!

    Grazie!

    P.S.
    @ Cromagno: sì, nel foglio 3 ci sono solo una decina di articoli messi come test: il conteggio non è su di essi, ma sul totale ordini del foglio1; cioè, quante volte si sono combinati 2 articoli aventi lo stesso numero seriale d'ordine.

  5. #5
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1
    Se può essere di aiuto,
    mi spiego ancora meglio, dato che il risultato atteso calcolato a mano non è banale.

    Se si filtra, nel foglio1, il seriale 105677, vengono fuori 37 articoli (codici). In questo caso, per questo ordine, il primo si incontra 1 volta con gli altri 36 e viceversa.
    Il conteggio, però, è d'interesse sul totale; sapere cioè quante volte è successo - per uno stesso ordine (e quindi sul totale ordini) che un articolo si accoppia ad un altro.

    :235:

  6. #6

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7174
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2066
    Likes dati
    1308
    Citazione Originariamente Scritto da M@urizio Visualizza Messaggio
    ....
    mi spiego ancora meglio....
    ......

    .
    :235::235::235:
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  7. #7

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4046
    Versione Office
    2013
    Likes ricevuti
    1239
    Likes dati
    931
    Non mi è ancora tanto chiaro, ma ti faccio notare una cosa del codice che mi è saltata all'occhio :

    Codice: 
    Sub ContaArticoliStessoSeriale()
    
    
    Dim x As Integer
    Dim y As Integer
    Dim Seriale As Integer
    Dim Conteggio As Integer
    Dim i As Integer
    Dim j As Integer
    Dim ArticoloFinale As Integer
    Dim RigaFinale As Long
    
    
    ArticoloFinale = Foglio3.Range("A1000").End(xlUp).Row
    
    
    For x = 2 To ArticoloFinale
        For y = 2 To ArticoloFinale
        
        'prendi i valori degli articoli da comparare
        ARTICOLO1 = Foglio3.Cells(1, x).Value
        ARTICOLO2 = Foglio3.Cells(y, 1).Value
        
        'trova i seriali per gli articoli nella matrice
            RigaFinale = Foglio1.Range("A8000").End(xlUp).Row
                   
            For i = 2 To RigaFinale
                If Foglio1.Cells(2, i).Value = ARTICOLO1 Then
                    Seriale = Foglio1.Cells(1, i).Value
                
                    For j = 2 To RigaFinale
                        If Foglio1.Cells(1, j).Value = Seriale And Foglio1.Cells(2, j).Value = ARTICOLO2 Then
                            Conteggio = Conteggio + 1
                        End If
                    Next j
            
                End If
            Next i
        
        'incolla i valori contati nella matrice
        Foglio3.Cells(x, y).Value = Conteggio
        
        Next y
    Next x
        
    End Sub
    Nelle parti in rosso, mi sa che hai invertito la riga con la colonna.
    Dovrebbe essere:

    Codice: 
     If Foglio1.Cells(i,2).Value = ARTICOLO1 Then
    e:

    Codice: 
    If Foglio1.Cells(j, 1).Value = Seriale And Foglio1.Cells(j, 2).Value = ARTICOLO2 Then
    [EDIT]
    Inoltre, quando devi indicare ad esempio il Foglio3 dovresti scrivere:

    Worksheets("Foglio3") oppure Worksheets("Foglio3") o ancora Sheets(3)

    Ma visto che il tuo foglio3 si chiama "Routine", devi indicarlo così:

    Worksheets("Routine")

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  8. #8

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4046
    Versione Office
    2013
    Likes ricevuti
    1239
    Likes dati
    931
    Allora, dopo una "prima revisione"....
    Il tuo codice senza errori di sintassi dovrebbe essere questo:

    Codice: 
    Sub ContaArticoliStessoSeriale()
    
    
    Dim x As Long
    Dim y As Long
    Dim Seriale As Long
    Dim Conteggio As Long
    Dim i As Long
    Dim j As Long
    Dim ArticoloFinale As Long
    Dim RigaFinale As Long
    
    
    ArticoloFinale = Worksheets("Routine").Range("A1000").End(xlUp).Row
    
    
    For x = 2 To ArticoloFinale
        For y = 2 To ArticoloFinale
        
        'prendi i valori degli articoli da comparare
        ARTICOLO1 = Worksheets("Routine").Cells(1, x).Value
        ARTICOLO2 = Worksheets("Routine").Cells(y, 1).Value
        
        'trova i seriali per gli articoli nella matrice
            RigaFinale = Worksheets("Seriali").Range("A" & Rows.Count).End(xlUp).Row
                   
            For i = 2 To RigaFinale
                If Sheets(1).Cells(i, 2).Value = ARTICOLO1 Then
                    Seriale = Sheets(1).Cells(i, 1).Value
                
                    For j = 2 To RigaFinale
                        If Sheets(1).Cells(j, 1).Value = Seriale And Sheets(1).Cells(j, 2).Value = ARTICOLO2 Then
                            Conteggio = Conteggio + 1
                        End If
                    Next j
            
                End If
            Next i
        
        'incolla i valori contati nella matrice
        Sheets(3).Cells(x, y).Value = Conteggio
        
        Next y
    Next x
        
    End Sub
    Funziona ma.... dovendo controllare ripetutamente 8000 righe, è molto lento anzi... tende a bloccarsi.
    Quindi dovrai prendere un'altra strada.....

    P.S.
    Quando dichiari delle variabili che assumeranno gli indici di righe e colonne ti conviene sempre usare Long non Integer.

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  9. #9
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1
    Cromagno,

    innanzitutto grazie infinite, sia per le dritte sia per il tempo dedicatomi: davvero impagabile...

    Ho un unico dubbio sul risultato che viene fuori: la matrice che viene scritta dovrebbe essere simmetrica - o almeno così me l'aspetto - perché se l'articolo A si combina con l'articolo B 300 volte... allora anche l'articolo B dovrebbe combinarsi con l'articolo A 300 volte.

    In sostanza, matematicamente, nella matrice dovrebbe essere a12 = a21. E forse questa cosa, opportunamente indirizzata, dimezzerebbe anche i calcoli.

    :92:

    Humm...

  10. #10

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4046
    Versione Office
    2013
    Likes ricevuti
    1239
    Likes dati
    931
    Citazione Originariamente Scritto da M@urizio Visualizza Messaggio
    Cromagno,

    Ho un unico dubbio sul risultato che viene fuori: la matrice che viene scritta dovrebbe essere simmetrica - o almeno così me l'aspetto - perché se l'articolo A si combina con l'articolo B 300 volte... allora anche l'articolo B dovrebbe combinarsi con l'articolo A 300 volte.
    Ciao Maurizio,
    ho messo a posto solo la sintassi, non ho modificato nulla della logica del codice.
    Però si, in effetti per lo stesso articolo il numero di combinazioni dovrebbe essere lo stesso.

    Nel caso domani pomeriggio provo a dare un'occhiata alla logica (sempre se qualche anima pia non intervenga prima :32: ).

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  11. #11

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4046
    Versione Office
    2013
    Likes ricevuti
    1239
    Likes dati
    931
    Ciao,
    ho provato a fare qualcosa con le matrici in modo da velocizzare un pò...

    Codice: 
    Sub Seriali_Uguali()
    Dim i As Long, j As Long, MatrArticoli() As Long, MatrSeriali() As Long, uRiga1 As Long
    Dim Seriali As Worksheet, uriga2 As Long, inizio As Double
    
    
    inizio = Time
    Set Seriali = Worksheets("Seriali")
    'uRiga1 = Seriali.Range("A" & Rows.Count).End(xlUp).Row
    uriga2 = Range("A" & Rows.Count).End(xlUp).Row
    uRiga1 = 1000
    ReDim MatrArticoli(1 To uRiga1, 1 To uRiga1)
    ReDim MatrSeriali(1 To uRiga1)
    
    
    Application.ScreenUpdating = False
    Range(Cells(2, 1), Cells(uriga2, uriga2)).ClearContents
    With Seriali
        For i = 2 To uRiga1
            MatrArticoli(1, i) = .Cells(i, 2).Value
            MatrArticoli(i, 1) = .Cells(i, 2).Value
            MatrSeriali(i) = .Cells(i, 1).Value
        Next i
    End With
    
    
    For i = 2 To uRiga1
        For j = 2 To uRiga1
            If MatrSeriali(i) = MatrSeriali(j) Then
                MatrArticoli(j, i) = MatrArticoli(j, i) + 1
            End If
        Next j
    Next i
    
    
    For i = 1 To uRiga1
        For j = 1 To uRiga1
            Cells(i + 1, j).Value = MatrArticoli(i, j)
        Next j
    Next i
    
    
    Range("A2").Value = "Articoli"
    Application.ScreenUpdating = True
    Set Seriali = Nothing
    MsgBox "Completato in " & Time - inizio & " sec."
    End Sub
    Ci mette comunque molto tempo (con ragione :176: ).
    Come vedi ho impostato la variabile "uRiga1" a 1000 (invece di farla arrivare fino a 8000 come dovrebbe) e già così ci impiega quasi 30 secondi col mio pc... ma devi tenere conto che all'aumentare di quel numero il tempo aumenterà esponenzialmente (o almeno credo).

    Per provare con tutti gli articoli, devi togliere l'apice che ho messo all'inizio della riga in verde e metterlo invece all'inizio della riga in rosso.

    Alla fine, sempre se non ho capito male, nella tabella avrai solamente o degli zero (0) o degli uno (1).

    Fai una prova, ti lascio il file in allegato. Premi il tasto "Verifica" per far partire la macro.

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  12. I seguenti utenti hanno dato un "Like"


  13. #12

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1027
    Versione Office
    .
    Likes ricevuti
    368
    Likes dati
    0
    Ciao Tore,

    Citazione Originariamente Scritto da cromagno Visualizza Messaggio
    Inoltre, quando devi indicare ad esempio il Foglio3 dovresti scrivere:

    Worksheets("Foglio3") oppure Worksheets("Foglio3") o ancora Sheets(3)

    Ma visto che il tuo foglio3 si chiama "Routine", devi indicarlo così:

    Worksheets("Routine")
    Solo un appunto. Usare il codename per riferirsi ad un foglio è il sistema più sicuro; infatti non viene influenzato da azioni che può compiere l'utente che potrebbero compromettere il funzionamento del codice, come il rinominare un foglio (Worksheets("Foglio3") fallirebbe) o spostarlo di posizione (Sheets(3) fallirebbe).

    Il punto da tenere ben presente è che è possibile riferirsi direttamente tramite il codename solo a fogli della cartella a cui appartiene il progetto VBA.

    Inserite questo codice in un modulo standard di un file:

    Codice: 
    Sub prova()
      MsgBox "ActiveWorkbook.Name: " & ActiveWorkbook.Name & vbCrLf & vbCrLf & _
        "ActiveSheet.Name: " & ActiveSheet.Name & vbCrLf & vbCrLf & _
        "ActiveSheet.CodeName: " & ActiveSheet.CodeName & vbCrLf & vbCrLf & _
        "Foglio1.CodeName: " & Foglio1.CodeName & vbCrLf & vbCrLf & _
        "Foglio1 appartiene a: " & Foglio1.Parent.Name
      Application.Workbooks.Add
      ActiveSheet.Name = "Pippo"
      MsgBox "ActiveWorkbook.Name: " & ActiveWorkbook.Name & vbCrLf & vbCrLf & _
        "ActiveSheet.Name: " & ActiveSheet.Name & vbCrLf & vbCrLf & _
        "ActiveSheet.CodeName: " & ActiveSheet.CodeName & vbCrLf & vbCrLf & _
        "Foglio1.CodeName: " & Foglio1.CodeName & vbCrLf & vbCrLf & _
        "Foglio1 appartiene a: " & Foglio1.Parent.Name
    End Sub
    Ma se nel nostro codice, anziché usare WorkBooks.Add, aprissimo (con WorkBooks.Open) un'altra cartella di lavoro e questa nel codice dell'evento Open() avesse il codice indicato (con Application.Workbooks.Add), potrete notate come il codename Foglio1 faccia riferimento al Foglio1 della cartella appena aperta (a cui appartiene il codice in esecuzione).
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  14. I seguenti 3 utenti hanno dato un "Like" a scossa per questo post:


  15. #13

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7174
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2066
    Likes dati
    1308
    Citazione Originariamente Scritto da scossa Visualizza Messaggio

    ...... Usare il codename per riferirsi ad un foglio è il sistema più sicuro; infatti non viene influenzato da azioni che può compiere l'utente che potrebbero compromettere il funzionamento del codice, come il rinominare un foglio (Worksheets("Foglio3") fallirebbe) o spostarlo di posizione (Sheets(3) fallirebbe).

    Il punto da tenere ben presente è che è possibile riferirsi direttamente tramite il codename solo a fogli della cartella a cui appartiene il progetto VBA.

    Inserite questo codice in un modulo standard di un file:

    Codice: 
    Sub prova()
      MsgBox "ActiveWorkbook.Name: " & ActiveWorkbook.Name & vbCrLf & vbCrLf & _
        "ActiveSheet.Name: " & ActiveSheet.Name & vbCrLf & vbCrLf & _
        "ActiveSheet.CodeName: " & ActiveSheet.CodeName & vbCrLf & vbCrLf & _
        "Foglio1.CodeName: " & Foglio1.CodeName & vbCrLf & vbCrLf & _
        "Foglio1 appartiene a: " & Foglio1.Parent.Name
      Application.Workbooks.Add
      ActiveSheet.Name = "Pippo"
      MsgBox "ActiveWorkbook.Name: " & ActiveWorkbook.Name & vbCrLf & vbCrLf & _
        "ActiveSheet.Name: " & ActiveSheet.Name & vbCrLf & vbCrLf & _
        "ActiveSheet.CodeName: " & ActiveSheet.CodeName & vbCrLf & vbCrLf & _
        "Foglio1.CodeName: " & Foglio1.CodeName & vbCrLf & vbCrLf & _
        "Foglio1 appartiene a: " & Foglio1.Parent.Name
    End Sub
    Ma se nel nostro codice, anziché usare WorkBooks.Add, aprissimo (con WorkBooks.Open) un'altra cartella di lavoro e questa nel codice dell'evento Open() avesse il codice indicato (con Application.Workbooks.Add), potrete notate come il codename Foglio1 faccia riferimento al Foglio1 della cartella appena aperta (a cui appartiene il codice in esecuzione).
    Questa è un'utilissima lezione, me la conservo tra i miei appunti.
    Grazie scossa. :90:
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  16. #14

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1027
    Versione Office
    .
    Likes ricevuti
    368
    Likes dati
    0
    Ciao a tutti,

    maurizio, ci sono molte cose che non mi quadrano, partiamo dalla prima: è corretto che nello stesso ordine (che mi sembra chiami anche seriale) un articolo sia presente più di una volta?
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  17. #15
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1
    Ragazzi!

    Grazie a tutti... davvero!!!

    Parto da Scossa: in genere no, ma immagino che lo stesso articolo possa provenire, talvolta, da più lotti (per esaurimento); quindi l'issue, che credo riguardi un numero limitato di righe, in realtà, non è un issue. Al netto quindi ci può stare.

    @Cromagno: ti ringrazio veramente tanto! Solo una cosa: avere un flag binario è certamente utile, ma nulla ci dice circa la forza di questo abbinamento. Il top sarebbe proprio contarli, sapere cioè quante volte quella coppia di articoli è uscita in uno stesso ordine sul totale degli ordini.
    Nel secondo pomeriggio, ritorno a casa e faccio le prove dovute!

    Ringrazio ancora! Davvero...

  18. #16

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4046
    Versione Office
    2013
    Likes ricevuti
    1239
    Likes dati
    931
    Citazione Originariamente Scritto da M@urizio Visualizza Messaggio
    ......... Il top sarebbe proprio contarli, sapere cioè quante volte quella coppia di articoli è uscita in uno stesso ordine sul totale degli ordini.
    Ciao Maurizio,
    è proprio questa parte che non mi è chiara... :92:

    @scossa
    come sempre....grazie per le tue chicche (che sarebbe difficile trovare altrimenti se non sbattendoci la testa :292: ).
    :246:

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  19. #17
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1
    Ah!
    Scusami allora, mi spiego:

    Riprendo quanto scritto ieri. Esempio: se si filtra, nel foglio1, il seriale 105677, vengono fuori 37 articoli (codici). In questo caso, per questo ordine, ogni articolo richiesto si accoppia 1 volta (una sola) con gli altri 36 e viceversa (mi pare non ci siano nemmeno articoli duplicati in questo ordine).
    Il conteggio, però, è d'interesse sul totale; sapere cioè quante volte è successo - che in uno stesso ordine - sono usciti ad esempio gli articoli A e B insieme.
    Ecco perché nel primo file che ho postato, nel terzo foglio di lavoro, c'erano gli articoli univoci disposti ai bordi della matrice come intestazioni: proprio per contarne gli accoppiamenti in ogni ordine degli 8000...! [chiaramente là ho preso solo i primi 10 articoli come test, dal foglio 2 degli articoli univoci, per evitare di metterli tutti e 500!]

    :270:

  20. #18

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1027
    Versione Office
    .
    Likes ricevuti
    368
    Likes dati
    0
    Ciao,

    Sperando di aver capito la tua esigenza, il seguente codice elabora il tuo archivio (8.000 ordini) in circa 6 secondi sul mio vecchio pc:

    Codice: 
    '---------------------------------------------------------------------------------------
    ' Procedure : CreaPivot
    ' Author    : scossa
    ' Date      : 10/01/2016
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
    Public Sub CreaPivot()
      
      On Error GoTo CreaPivot_Error
    
    
      Dim wb As Workbook
      Dim wsFr As Worksheet
      Dim wsTo As Worksheet
      Dim wsPivot As Worksheet
      Dim rngFr As Range
      Dim rngTo As Range
      Dim pvtTb As PivotTable
      Dim aRng() As Variant
      Dim arngTrs() As Variant
      Dim aOrd() As Variant
      Dim aArt() As Variant
      Dim aRis() As Variant
      Dim nLRord As Long
      Dim nLRart As Long
      Dim jOrd As Long
      Dim kArt As Long
      Dim k As Long
      Dim nCodArt As Long
      Dim nCodOrd As Long
      Dim nStart As Single
      Dim bCalc As XlCalculation
      
      nStart = Timer
      With Application
        bCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
      End With
        
      Set wb = ThisWorkbook
      Set wsFr = wb.Worksheets("Seriali")
      Set wsTo = wb.Worksheets("Routine")
      Set rngFr = wsFr.Range("A1").CurrentRegion
      Set wsPivot = wb.Sheets.Add(before:=wsFr)
      wsTo.Select
      With wb.Worksheets("Univoci")
        nLRord = .Cells(Rows.Count, 1).End(xlUp).Row
        nLRart = .Cells(Rows.Count, 2).End(xlUp).Row
        aOrd = .Range("A2:A" & nLRord).Value
        aArt = .Range("B2:B" & nLRart).Value
        ReDim aRis(1 To UBound(aArt), 1 To UBound(aArt))
      End With
      With wsTo
        Set rngTo = .Range(.Cells(3, 3), .Cells(nLRart + 1, nLRart + 1))
        rngTo.ClearContents
        rngTo.Offset(-1, 0).Resize(1) = Application.Transpose(aArt)
        rngTo.Offset(0, -1).Resize(, 1) = aArt
    
    
      End With
      Set pvtTb = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
          rngFr, Version:=xlPivotTableVersion14).CreatePivotTable(TableDestination:=wsPivot.Range("A3"), _
            TableName:="Pivot_Temp", _
            DefaultVersion:=xlPivotTableVersion14)
      
      With pvtTb
        With .PivotFields("Numero Seriale")
            .Orientation = xlRowField
            .Position = 1
        End With
        
        .AddDataField wsPivot.PivotTables( _
            "Pivot_Temp").PivotFields("Codice Articolo"), "Conteggio di Codice Articolo", _
            xlCount
        .CompactLayoutRowHeader = "Ordini"
        .CompactLayoutColumnHeader = "Articoli"
        
        With .PivotFields("Codice Articolo")
            .Orientation = xlColumnField
            .Position = 1
        End With
        .ColumnGrand = False
        .RowGrand = False
        aRng() = .DataBodyRange
        arngTrs = Application.WorksheetFunction.Transpose(aRng)
        For kArt = 1 To UBound(aArt)
          nCodArt = aArt(kArt, 1)
          Application.StatusBar = "sto valutando l'articolo " & nCodArt
          For jOrd = 1 To UBound(aOrd)
            nCodOrd = aOrd(jOrd, 1)
            'Application.StatusBar = "sto valutando l'articolo " & nCodArt & ", seriale " & nCodOrd
            If arngTrs(kArt, jOrd) = 1 Then
              For k = kArt + 1 To UBound(aArt)
                If aRng(jOrd, k) = 1 Then
                  aRis(kArt, k) = 1 'aArt(k, 1)
                End If
              Next
            End If
          Next jOrd
        Next kArt
      End With
        'aRis = Application.WorksheetFunction.SumProduct(Application.WorksheetFunction.Transpose(aRis), aRis)
      
      With rngTo
        .Value = aRis
        .Value = Evaluate("=TRANSPOSE(" & .Address & ")+(" & .Address & ")")
        .NumberFormat = "#,##0;-#,##0;"""";@"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
      End With
      On Error GoTo 0
      Application.DisplayAlerts = False
      wsPivot.Delete
      Application.DisplayAlerts = True
    CreaPivot_Error:
      If Err.Number <> 0 Then
        MsgBox "Error: " & Err.Description, vbCritical, "ERRORE"
      End If
    
    
      Set rngFr = Nothing
      Set rngTo = Nothing
      Set wsFr = Nothing
      Set wsPivot = Nothing
      Set pvtTb = Nothing
      Set wb = Nothing
      With Application
        .Calculation = bCalc
        .ScreenUpdating = True
        .StatusBar = False
      End With
      MsgBox "finito in: " & Timer - nStart & " secondi"
    
    
    End Sub
    Attenzione: per utilizzare questo codice nel tuo file originale devi creare anche l'elenco univoco degli articoli; inoltre entrambi gli elenchi univoci devono essere in ordine dal valore più basso al più alto.

    In pratica la struttura del file deve essere quella del file che ho usato e che puoi scaricare da questo link:
    Esercitazione_scossa

    A te verificare se i conteggi sono corretti.
    Ultima modifica fatta da:scossa; 10/01/16 alle 21:02
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  21. I seguenti utenti hanno dato un "Like"


  22. #19
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1
    Ciao!
    Grazie...!

    ...è possibile verificare il link?
    Perché mi dà:

    Not Found

    The requested document was not found on this server.

  23. #20

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1027
    Versione Office
    .
    Likes ricevuti
    368
    Likes dati
    0
    Ho corretto il link sopra.
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  24. #21
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1
    Scossa,

    sei un mito! :97:

    Non è esattamente il risultato sperato (conteggio delle occorrenze degli accoppiamenti in ogni casella), ma va già benissimo così...!
    La macro è piuttosto avanzata: ora tocca digerirla! :258:

    Grazie mille, per il tempo e la pazienza...!

  25. #22

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1027
    Versione Office
    .
    Likes ricevuti
    368
    Likes dati
    0
    Citazione Originariamente Scritto da M@urizio Visualizza Messaggio
    La macro è piuttosto avanzata: ora tocca digerirla! :258:
    Ti consiglio di commentare l'istruzione
    wsPivot.Delete
    in modo da esaminare la tabella pivot "transitoria" che ho usato.
    Ricordati poi di eliminare il foglio.
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  26. #23
    L'avatar di Textomb
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Catania
    Età
    47
    Messaggi
    171
    Versione Office
    Excel 2016
    Likes ricevuti
    93
    Likes dati
    11
    @Maurizio
    Esercizio abbastanza intrigante.
    Però, se non ho capito male, mi aspetto una matrice quadrata speculare rispetto alla sua diagonale.
    Faccio un esempio per chiarire il concetto.
    Immaginiamo che, a fine elaborazione, il valore che trovo nella Riga 3 (lo chiamo art.R3) e nella Colonna 5 (lo chiamo art. C5) di questa matrice sia 38.
    Questo valore dovrebbe rappresentare il numero di volte in cui l'articolo R3 si trova assieme all'articolo C5 a parità di ordine seriale.
    Cioè scorrendo tutti gli ordini seriali guardo tutte le volte in cui questi due articoli siano usciti assieme nello stesso ordine.
    Siccome ho contato 913 ordini univoci, se il valore che è emerso è 38 vuol dire che R3 e C5 si sono trovati assieme 38 volte su 913 ordini.

    Mi dici se ho capito bene?
    Se dovesse essere così, non ho capito come leggere il risultato che emerge dalla routine (bella...) di scossa.
    Ultima modifica fatta da:Textomb; 12/01/16 alle 12:03 Motivo: ripetizione parola

  27. #24

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1027
    Versione Office
    .
    Likes ricevuti
    368
    Likes dati
    0
    Ciao,

    Citazione Originariamente Scritto da Textomb Visualizza Messaggio
    Se dovesse essere così, non ho capito come leggere il risultato che emerge dalla routine (bella...) di scossa.
    il risultato - una matrice quadrata (e speculare) di n righe x n colonne, dove n sono i valori (codici) univoci degli articoli - espone con un 1 gli abbinamenti di ciascun articolo con altro articolo ed è il primo (ed al momento l'unico) step che ho affrontato.
    Lo step successivo dovrebbe essere quello di sostituire gli 1 con il conteggio degli ordini in cui tale abbinamento avviene.
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  28. #25
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1
    @Textomb: esattamente.
    Tuttavia, la matrice non è mai perfettamente simmetrica, rispetto alla sua diagonale principale, perché può capitare che un ordine sia composto, ad esempio, anche da due articoli uguali a causa dell'esaurimento del lotto di provenienza (e quindi l'articolo duplicato sull'ordine in esame riflette la necessità di distinguere il numero di lotto nella query data). Sì, è senz'altro un esercizio molto intrigante perché rappresenta la base per ottimizzare i flussi di lavoro; e disporre di conseguenza i materiali in modo "ottimo" rispetto a quella che risulta essere la richiesta attesa (conosco le dipendenze reciproche degli articoli, li sistemo vicini, aumento la produttività).

    @Scossa: di nuovo grazie mille! Non è mai abbastanza!
    Non appena ho un minuto libero, vado ad applicare ciò che mi hai consigliato in ultima istanza per osservare un pò la Pivot...

    Chiedo sempre venia per il fatto di produrre più domande che risposte... ma sono fuori casa in media 11h al giorno :280:

  29. #26
    L'avatar di Textomb
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Catania
    Età
    47
    Messaggi
    171
    Versione Office
    Excel 2016
    Likes ricevuti
    93
    Likes dati
    11
    Oggi ho pensato (ma senza fare prove) su come risolvere questo quesito. Non solo non ho trovato soluzione facile e percorribile, ma addirittura non ho neanche capito quale strada si potrebbe intraprendere.
    :92:

  30. #27
    L'avatar di M@urizio
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Roma
    Età
    36
    Messaggi
    28
    Versione Office
    Excel 2016
    Likes ricevuti
    1
    Ciao!

    Sicuramente, per limitare i calcoli, gli accoppiamenti potrebbero essere contati solo per j>i (colonna maggiore di riga, andando a circoscrivere proprio l'area della diagonale in altro a destra - o, viceversa, per j<i scegliendo la parte di sotto).
    L'ipotesi è che la matrice sia perfettamente simmetrica (ottenibile, in prima battuta, con una macro di clean-up che tolga gli articoli doppioni su ogni ordine); ma ti giuro che non ho ancora avuto modo di mettermici...!

  31. #28

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1027
    Versione Office
    .
    Likes ricevuti
    368
    Likes dati
    0
    Citazione Originariamente Scritto da Textomb Visualizza Messaggio
    Oggi ho pensato (ma senza fare prove) su come risolvere questo quesito. Non solo non ho trovato soluzione facile e percorribile, ma addirittura non ho neanche capito quale strada si potrebbe intraprendere.
    :92:

    Ieri sera ci ho ragionato su ed una soluzione logica l'ho trovata.
    Si tratta di utilizzare l'autofilter, applicandolo a coppie di prodotti a partire dal primo prodotto col secondo (primo col terzo ....) fino ad arrivare al penultimo con l'ultimo (per 432 prodotti abbiamo 431+430+429 .... 3+2 = 93.527 iterazioni) .
    Il problema è che, per avere il risultato della formula SUBTOTALE() per il conteggio del risultato dell'applicazione del filtro, Application.Calculation deve essere in automatico ed il tempo di esecuzione è inaccettabile (stimato in ore).

    Poi ho avuto l'idea risolutiva: disabilitare il ricalcolo automatico e calcolare solo la cella del singolo risultato. In poco più di 2 minuti fornisce quanto richiesto.

    Ovviamente andrebbe integrata con un pop-up che mostri la progressione dell'elaborazione (application.statusbar non si aggiorna regolarmente) ma questi sono dettagli.

    Allego il file:

    P.S.: non ho verificato la correttezza dei risultati, quindi ...... controllate bene.
    File Allegati File Allegati
    Ultima modifica fatta da:scossa; 15/01/16 alle 14:25
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

  32. I seguenti 3 utenti hanno dato un "Like" a scossa per questo post:


  33. #29
    L'avatar di Textomb
    Clicca e Apri
    Data Registrazione
    Sep 2015
    Località
    Catania
    Età
    47
    Messaggi
    171
    Versione Office
    Excel 2016
    Likes ricevuti
    93
    Likes dati
    11
    @scossa
    Ero impegnato in una riunione (noiosa tra l'altro...). Ricevuto il messagio ed incuriosito trovo una scusa per dileguarmi.:188:
    Dunque ho fatto delle verifiche a campione sui valori e risulta perfetto.
    Tra l'altro gira in poco meno di due minuti...
    Sarebbe il massimo riuscire a dimezzare la durata. Già entro il minuto sarebbe più accettabile.
    In ogni caso resta un lavoro da dieci e lode! Complimenti!!!

  34. #30

    L'avatar di scossa
    Clicca e Apri
    Data Registrazione
    Jul 2015
    Località
    Verona Provincia
    Età
    57
    Messaggi
    1027
    Versione Office
    .
    Likes ricevuti
    368
    Likes dati
    0
    Citazione Originariamente Scritto da Textomb Visualizza Messaggio
    Dunque ho fatto delle verifiche a campione sui valori e risulta perfetto.
    Ciao Alberto,

    ti ringrazio per la verifica ed il riscontro, ora aspettiamo m@aurizo.
    Bye!
    scossa
    scossa's web site
    ___
    Se tu hai una mela, e io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

Discussioni Simili

  1. [Risolto] Abbinamenti
    Di sergiogranero nel forum Domande su Microsoft Access
    Risposte: 48
    Ultimo Messaggio: 22/10/16, 09:46
  2. [Risolto] Contare con più criteri
    Di Roker1 nel forum Domande su Excel in generale
    Risposte: 10
    Ultimo Messaggio: 10/10/16, 11:26
  3. come costruire una matrice quadrata?
    Di ghibbli nel forum Domande su Excel in generale
    Risposte: 6
    Ultimo Messaggio: 03/08/16, 08:03
  4. contare mese e giorno
    Di broadband nel forum Domande su Excel in generale
    Risposte: 12
    Ultimo Messaggio: 15/02/16, 23:26
  5. Contare con più condizioni
    Di nick0573 nel forum Domande su Excel in generale
    Risposte: 9
    Ultimo Messaggio: 29/12/15, 11:06

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •