You are here:---Rispondi a: [RISOLTO] FORMULA_UNICA
Rispondi a: [RISOLTO] FORMULA_UNICA 2019-01-31T12:47:45+02:00

Home Forum Domande su Formule e Funzioni [RISOLTO] FORMULA_UNICA Rispondi a: [RISOLTO] FORMULA_UNICA

sidsid
Moderatore
    Post totali: 687
    Sub COMBINAZIONI()
    Dim rng As Range, cella As Range
    Dim arr As Variant, matrix() As Variant
    Dim n As Integer ', nSomma As Integer
    Dim j As Long, jj As Long, k As Long
    
    On Error Resume Next
    Set rng = Application.InputBox("seleziona il range di celle da combinare", Type:=8)
    If rng Is Nothing Then GoTo USCITA
    Set cella = Application.InputBox("seleziona la cella da dove cominciare la copia", Type:=8)
    If cella Is Nothing Then GoTo USCITA
    On Error GoTo 0
    
    arr = rng.Value
    n = UBound(arr, 2) * (UBound(arr, 2) - 1) / 2
    ReDim matrix(1 To 1, 1 To n)
    For j = LBound(arr, 2) To UBound(arr, 2) - 1
        For jj = j + 1 To UBound(arr, 2)
            k = k + 1
            'nSomma = arr(1, j) + arr(1, jj)
            'matrix(1, k) = IIf(nSomma > 90, nSomma - 90, nSomma)
            matrix(1, k) = arr(1, j) & "_" & arr(1, jj)
        Next jj
    Next j
    With cella
        .Resize(, 190).ClearContents
        .Resize(, n).Value = matrix
    End With
    
    Set rng = Nothing
    Set cella = Nothing
    
    Exit Sub
    USCITA:
    MsgBox "Operazione annullata", vbExclamation
    On Error GoTo 0
    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