You are here:---Rispondi a: [RISOLTO] Quaterne
Rispondi a: [RISOLTO] Quaterne2018-05-14T11:56:55+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Quaterne Rispondi a: [RISOLTO] Quaterne

sidsid
Moderatore
    Post totali: 718

    Prova questa variante

    Sub QUATERNE()
    Dim x As Variant, vQuaterne(1 To 18, 1 To 4845) As Variant
    Dim j As Long, jj As Long, jjj As Long, jjjj As Long, nIncr As Long, nUltimaRiga As Long, xRiga As Long
    Dim ws1 As Worksheet
    Dim rTab As Range
    Dim nRiga As Integer, n As Integer, nPrimaRiga As Integer
    
    Set ws1 = Sheets("Foglio1")
    Set rTab = ws1.Range("C10:V27")
    nPrimaRiga = rTab.Row 'prima riga della tabella
    nUltimaRiga = rTab.Rows(rTab.Rows.Count).Row 'ultima riga della tabella
    xRiga = nPrimaRiga
    
    For nRiga = 1 To rTab.Rows.Count
        n = Application.WorksheetFunction.CountA(rTab.Rows(nRiga))
        x = Application.Transpose(ws1.Range(ws1.Cells(nPrimaRiga, 3), ws1.Cells(nPrimaRiga, n + 2)).Value)
        For j = LBound(x) To UBound(x) - 3
            For jj = j + 1 To UBound(x) - 2
                 For jjj = jj + 1 To UBound(x) - 1
                    For jjjj = jjj + 1 To UBound(x)
                        nIncr = nIncr + 1
                        vQuaterne(nRiga, nIncr) = x(j, 1) & "_" & x(jj, 1) & "_" & x(jjj, 1) & "_" & x(jjjj, 1)
                    
                    Next jjjj
                Next jjj
            Next jj
        Next j
        nPrimaRiga = nPrimaRiga + 1
        nIncr = 0
    Next nRiga
    ws1.Range("W" & xRiga & ":GEE" & nUltimaRiga).Value = vQuaterne
    
    Set rTab = Nothing
    Set ws1 = Nothing
    End Sub

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi