You are here:---Rispondi a: Numeri unici
Rispondi a: Numeri unici2019-02-28T19:55:14+02:00

Home Forum Domande su Excel VBA e MACRO Numeri unici Rispondi a: Numeri unici

sidsid
Moderatore
    Post totali: 718

    Questa la macro adattata per come è la struttura della tabella che hai inviato.
    Da abbinare ad un pulsante

    Sub NUMERI_UNICI()
    Dim ws As Worksheet
    Dim vTabella As Variant, vNColonne As Variant, vRiga(19) As Variant, vFinale(1 To 4005, 1 To 2)
    Dim j As Long, jj As Long, k As Long, kk As Long, nRiga As Long
    Dim sNumeri As String, sColonne As String
    Dim N As Integer
    
    Set ws = Sheets("Foglio1") 'nome tuo foglio
    nRiga = ws.Range("B" & Rows.Count).End(xlUp).Row
    vTabella = ws.Range("B3:AM" & nRiga)
    
    'questo array contine le colonne di riferimento della tabella
    vNColonne = Array(1, 2, 5, 6, 9, 10, 13, 14, 17, 18, 21, 22, 25, 26, 29, 30, 33, 34, 37, 38)
    For j = LBound(vTabella) To UBound(vTabella)
        
        For jj = LBound(vNColonne) To UBound(vNColonne)
            vRiga(jj) = vTabella(j, vNColonne(jj))
        Next jj
        sNumeri = "#" & Join(vRiga, "##") & "#"
        For jj = LBound(vRiga) To UBound(vRiga) - 1 Step 2
            k = k + 1
            With Application.WorksheetFunction
            Select Case True
                 Case (Len(sNumeri) - Len(.Substitute(sNumeri, "#" & vRiga(jj) & "#", _
                        vbNullString))) / Len("#" & vRiga(jj) & "#") = 1 And _
                      (Len(sNumeri) - Len(.Substitute(sNumeri, "#" & vRiga(jj + 1) & "#", _
                        vbNullString))) / Len("#" & vRiga(jj + 1) & "#") = 1
                N = N + 1
                sColonne = sColonne & k & "-"
            End Select
            End With
        Next jj
        kk = kk + 1
        vFinale(kk, 1) = N
        If sColonne = vbNullString Then
            vFinale(kk, 2) = vbNullString
        Else
            vFinale(kk, 2) = Mid(sColonne, 1, Len(sColonne) - 1)
        End If
        N = 0
        k = 0
        sColonne = vbNullString
    Next j
    With ws.Range("AX3:AY" & 4007)
        .ClearContents
        .Value = vFinale
    End With
    
    Set ws = 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