Risultati da 1 a 10 di 10

Discussione: Estrarre combinazioni da una riga



  1. #1
    L'avatar di dario
    Clicca e Apri
    Data Registrazione
    Sep 2016
    LocalitÓ
    bergamo
    Messaggi
    5
    Versione Office
    2010
    Likes ricevuti
    0
    Likes dati
    0

    Estrarre combinazioni da una riga

    Ciao a tutti,
    sono alle primissime armi con VBA e ho bisogno di estrarre dei dati dalle righe di una tabella. Ho allegato un file di esempio per spiegare meglio di che si tratta. In pratica devo creare un elenco di combinazioni che si creano combinando ogni elemento di ciascuna categoria con gli elementi delle altre categorie, relativamente alla stessa riga. Nel file allegato Ŕ spiegato nel dettaglio e si comprende meglio cosa voglio dire.
    Scrivete se volete ulteriori chiarimenti.
    Grazie a chi mi aiuterÓ.
    File Allegati File Allegati

  2. #2

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Cosenza
    EtÓ
    45
    Messaggi
    2801
    Versione Office
    Excel 2013
    Likes ricevuti
    1019
    Likes dati
    977

    Re: Estrarre combinazioni da una riga

    Prova con questa routine:
    Codice: 
     
    Option Compare Text
    Option Explicit
    
    
    Sub Genera()
    Dim CatB()
    Dim CatC()
    Dim CatD()
    Dim CatE()
    Dim NumB As Integer
    Dim NumC As Integer
    Dim NumD As Integer
    Dim NumE As Integer
    Dim RngB As Range
    Dim RngC As Range
    Dim RngD As Range
    Dim RngE As Range
    Dim iRow As Long
    Dim uRiga As Long
    Dim i As Integer
    Dim Cella As Range
    Dim a As Long, b As Long, c As Long, d As Long
    
    
    uRiga = Foglio1.Cells(Rows.Count, 1).End(xlUp).Row
    For iRow = 4 To uRiga
    
    
        Set RngB = Range("b" & iRow & ":n" & iRow) 'riferimento Categoria B
        Set RngC = Range("o" & iRow & ":p" & iRow) 'riferimento Categoria C
        Set RngD = Range("q" & iRow & ":x" & iRow) 'riferimento Categoria D
        Set RngE = Range("y" & iRow & ":al" & iRow) 'riferimento Categoria E
    
    
        NumB = WorksheetFunction.CountIf(RngB, "x") 'conteggio x Categoria B
        NumC = WorksheetFunction.CountIf(RngC, "x") 'conteggio x Categoria C
        NumD = WorksheetFunction.CountIf(RngD, "x") 'conteggio x Categoria D
        NumE = WorksheetFunction.CountIf(RngE, "x") 'conteggio x Categoria E
    
    
        'ridimensionamento matrici
        ReDim CatB(1 To NumB)
        ReDim CatC(1 To NumC)
        ReDim CatD(1 To NumD)
        ReDim CatE(1 To NumE)
    
    
        'carica matrice Categoria B
        i = 0
        For Each Cella In RngB
            If Cella = "x" Then
                i = i + 1
                CatB(i) = Cells(3, Cella.Column)
            End If
        Next
    
    
        'carica matrice Categoria C
        i = 0
        For Each Cella In RngC
            If Cella = "x" Then
                i = i + 1
                CatC(i) = Cells(3, Cella.Column)
            End If
        Next
    
    
        'carica matrice Categoria D
        i = 0
        For Each Cella In RngD
            If Cella = "x" Then
                i = i + 1
                CatD(i) = Cells(3, Cella.Column)
            End If
        Next
    
    
        'carica matrice Categoria E
        i = 0
        For Each Cella In RngE
            If Cella = "x" Then
                i = i + 1
                CatE(i) = Cells(3, Cella.Column)
            End If
        Next
    
    
        'ciclo combinazione matrici (B-C-D-E)
        For a = 1 To UBound(CatB)
            For b = 1 To UBound(CatC)
                For c = 1 To UBound(CatD)
                    For d = 1 To UBound(CatE)
                        Debug.Print CatB(a) & CatC(b) & CatD(c) & CatE(d)
                        f = f + 1
                    Next
                Next
            Next
        Next
    Next
    
    
    Set RngB = Nothing
    Set RngC = Nothing
    Set RngD = Nothing
    Set RngE = Nothing
    Erase RngB
    Erase RngC
    Erase RngD
    Erase RngE
    
    
    End Sub
    Non sapendo dove volevi scrivere le combinazioni, le ho scritte nella finestra immediata del Vba editor

    Inviato dal mio GT-I9301I utilizzando Tapatalk
    Ultima modifica fatta da:Rubik72; 12/09/16 alle 20:28

  3. I seguenti utenti hanno dato un "Like"

    ges

  4. #3
    L'avatar di dario
    Clicca e Apri
    Data Registrazione
    Sep 2016
    LocalitÓ
    bergamo
    Messaggi
    5
    Versione Office
    2010
    Likes ricevuti
    0
    Likes dati
    0

    Re: Estrarre combinazioni da una riga

    Ciao e grazie per la risposta.

    In realtÓ quello allegato Ŕ un file molto piccolo rispetto alla tabella sulla quale dovr˛ lavorare, mi aspetto un numero molto grande di combinazioni generate una volta riuscito ad ultimare il processo. Di conseguenza penso sia meglio generare le combinazioni in un altro foglio.
    Scusa ma ho provato a copiare e incollare il programma nell'editor ma mi dÓ subito il messaggio di errore quando avvio la macro. A partire dalla riga 27 e fino alla 89 il testo Ŕ colorato di rosso e facendo partire la macro spunta il messaggio di errore di sintassi. Cosa ho sbagliato?

    Grazie per l'aiuto

  5. #4

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Cosenza
    EtÓ
    45
    Messaggi
    2801
    Versione Office
    Excel 2013
    Likes ricevuti
    1019
    Likes dati
    977

    Re: Estrarre combinazioni da una riga

    Prova con queste modifiche:

    Codice: 
    Sub Genera_Coll()
    Dim CatB()
    Dim CatC()
    Dim CatD()
    Dim CatE()
    Dim NumB As Integer
    Dim NumC As Integer
    Dim NumD As Integer
    Dim NumE As Integer
    Dim RngB As Range
    Dim RngC As Range
    Dim RngD As Range
    Dim RngE As Range
    Dim iRow As Long
    Dim uRiga As Long
    Dim i As Integer
    Dim Cella As Range
    Dim a As Long, b As Long, c As Long, d As Long
    Dim NewSh As Worksheet
    Dim iCol As Integer
    Dim ShOrig As Worksheet
    Dim Coll As Collection
    Dim Matrix()
    
    
    Set ShOrig = Foglio1
    Set NewSh = Sheets.Add(after:=Sheets(Sheets.Count))
    ShOrig.Activate
    
    
    uRiga = Foglio1.Cells(Rows.Count, 1).End(xlUp).Row
    For iRow = 4 To uRiga
    
    
        Set RngB = Range("b" & iRow & ":n" & iRow) 'riferimento Categoria B
        Set RngC = Range("o" & iRow & ":p" & iRow) 'riferimento Categoria C
        Set RngD = Range("q" & iRow & ":x" & iRow) 'riferimento Categoria D
        Set RngE = Range("y" & iRow & ":al" & iRow) 'riferimento Categoria E
    
    
        NumB = WorksheetFunction.CountIf(RngB, "x") 'conteggio x Categoria B
        NumC = WorksheetFunction.CountIf(RngC, "x") 'conteggio x Categoria C
        NumD = WorksheetFunction.CountIf(RngD, "x") 'conteggio x Categoria D
        NumE = WorksheetFunction.CountIf(RngE, "x") 'conteggio x Categoria E
    
    
        'ridimensionamento matrici
        ReDim CatB(1 To NumB)
        ReDim CatC(1 To NumC)
        ReDim CatD(1 To NumD)
        ReDim CatE(1 To NumE)
    
    
        'carica matrice Categoria B
        i = 0
        For Each Cella In RngB
            If Cella = "x" Then
                i = i + 1
                CatB(i) = Cells(3, Cella.Column)
            End If
        Next
    
    
        'carica matrice Categoria C
        i = 0
        For Each Cella In RngC
            If Cella = "x" Then
                i = i + 1
                CatC(i) = Cells(3, Cella.Column)
            End If
        Next
    
    
        'carica matrice Categoria D
        i = 0
        For Each Cella In RngD
            If Cella = "x" Then
                i = i + 1
                CatD(i) = Cells(3, Cella.Column)
            End If
        Next
    
    
        'carica matrice Categoria E
        i = 0
        For Each Cella In RngE
            If Cella = "x" Then
                i = i + 1
                CatE(i) = Cells(3, Cella.Column)
            End If
        Next
    
    
        'ciclo combinazione matrici (B-C-D-E)
        Set Coll = New Collection
        iCol = iCol + 1
        For a = 1 To UBound(CatB)
            For b = 1 To UBound(CatC)
                For c = 1 To UBound(CatD)
                    For d = 1 To UBound(CatE)
                        Coll.Add CatB(a) & CatC(b) & CatD(c) & CatE(d)
                    Next
                Next
            Next
        Next
        ReDim Matrix(1 To Coll.Count)
        For i = 1 To Coll.Count
            Matrix(i) = Coll(i)
        Next
        NewSh.Range(NewSh.Cells(1, iCol), NewSh.Cells(Coll.Count, iCol)) = Application.Transpose(Matrix())
    Next
    
    
    Set RngB = Nothing
    Set RngC = Nothing
    Set RngD = Nothing
    Set RngE = Nothing
    Erase CatB
    Erase CatC
    Erase CatD
    Erase CatE
    
    
    End Sub
    Per il messaggio di errore non ti posso aiutare se non ho il file completo.

    Inviato dal mio GT-I9301I utilizzando Tapatalk
    Ultima modifica fatta da:Rubik72; 12/09/16 alle 20:28

  6. #5
    L'avatar di dario
    Clicca e Apri
    Data Registrazione
    Sep 2016
    LocalitÓ
    bergamo
    Messaggi
    5
    Versione Office
    2010
    Likes ricevuti
    0
    Likes dati
    0

    Re: Estrarre combinazioni da una riga

    L'errore me lo da giÓ inserendo il codice nel file di esempio che ho postato. Mi segnala l'errore nelle righe con gli asterischi

  7. #6

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Cosenza
    EtÓ
    45
    Messaggi
    2801
    Versione Office
    Excel 2013
    Likes ricevuti
    1019
    Likes dati
    977

    Re: Estrarre combinazioni da una riga

    Purtroppo sono da cellulare e non riesco a modificare il codice, ma dovresti sostituire gli asterischi con lo spazio (con qualsiasi editor di testo, anche col blocco note di Windows)

    Inviato dal mio GT-I9301I utilizzando Tapatalk

  8. #7
    L'avatar di dario
    Clicca e Apri
    Data Registrazione
    Sep 2016
    LocalitÓ
    bergamo
    Messaggi
    5
    Versione Office
    2010
    Likes ricevuti
    0
    Likes dati
    0

    Re: Estrarre combinazioni da una riga

    Ok, fatto. Ora sembra a posto ma non visualizzo i risultati. Dove li trovo?

  9. #8

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Cosenza
    EtÓ
    45
    Messaggi
    2801
    Versione Office
    Excel 2013
    Likes ricevuti
    1019
    Likes dati
    977

    Re: Estrarre combinazioni da una riga

    La routine crea un nuovo foglio e scrive le combinazioni in ogni colonna

    Inviato dal mio GT-I9301I utilizzando Tapatalk
    Ultima modifica fatta da:Rubik72; 12/09/16 alle 20:30

  10. #9
    L'avatar di dario
    Clicca e Apri
    Data Registrazione
    Sep 2016
    LocalitÓ
    bergamo
    Messaggi
    5
    Versione Office
    2010
    Likes ricevuti
    0
    Likes dati
    0

    Re: Estrarre combinazioni da una riga

    Perfetto, ora sembra funzionare. Una cosa: mi serve anche che l'1 appaia nella stringa e che cambi quando si esauriscono le combinazioni della riga, diventando poi 2 e iniziando con le combinazioni della riga successiva

  11. #10

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Cosenza
    EtÓ
    45
    Messaggi
    2801
    Versione Office
    Excel 2013
    Likes ricevuti
    1019
    Likes dati
    977

    Re: Estrarre combinazioni da una riga

    Se ho capito bene, modifica questa riga:
    Codice: 
    [...]
        'ciclo combinazione matrici (B-C-D-E)
        Set Coll = New Collection
        iCol = iCol + 1
        For a = 1 To UBound(CatB)
            For b = 1 To UBound(CatC)
                For c = 1 To UBound(CatD)
                    For d = 1 To UBound(CatE)
                        Coll.Add iCol & CatB(a) & CatC(b) & CatD(c) & CatE(d)
                    Next
                Next
            Next
        Next
        ReDim Matrix(1 To Coll.Count)
        For i = 1 To Coll.Count
            Matrix(i) = Coll(i)
        Next
        NewSh.Range(NewSh.Cells(1, iCol), NewSh.Cells(Coll.Count, iCol)) = Application.Transpose(Matrix())
    [...]

Discussioni Simili

  1. [Risolto] estrarre da una riga con punteggiatura la parte iniziale
    Di stefanofusco nel forum Domande su Excel in generale
    Risposte: 4
    Ultimo Messaggio: 02/03/17, 16:15
  2. [Risolto] estrarre da una riga con punteggiatura una determinata sigla
    Di stefanofusco nel forum Domande su Excel in generale
    Risposte: 4
    Ultimo Messaggio: 02/03/17, 14:17
  3. Estrarre le intestazioni di campo e di riga di una tabella incrociata
    Di Carme2014 nel forum Domande su Excel in generale
    Risposte: 3
    Ultimo Messaggio: 11/06/16, 17:36
  4. Combinazioni
    Di ferposso61 nel forum Domande su Excel in generale
    Risposte: 12
    Ultimo Messaggio: 25/05/16, 22:04
  5. estrarre riga
    Di bek77 nel forum Domande su Excel in generale
    Risposte: 5
    Ultimo Messaggio: 27/01/16, 20:50

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
  •