Numeri in comune nelle colonne

di il
3 risposte

Numeri in comune nelle colonne

Salve,

avrei un problemino nel trovare alcuni numeri in comune in 4 colonne
Colonna A Colonna B Colonna C Colonna D
2 3 4 6
4 6 8 12
6 9 12 18
8 12 16 24
10 15 20 30
12 18 24 36
14 21 28 42
16 24 32 48
18 27 36 54
20 30 40 60


Dovrebbe venirmi nella colonna G
12
Unico numero in comune in tutte le caselle
Poi nella colonna J e K dovrei mettere i numeri che si ripetono piu' volte in J ed in K il numero di volte che si ripetono

Avreste un Suggerimento, cortesemente?

Grazie

3 Risposte

  • Re: Numeri in comune nelle colonne

    Ciao
    ricordati che è sempre meglio allegare un file per "vederne" la struttura.
    Ciò premesso, ammesso che i tuoi numeri si trovino nell'intervallo A1:D10, prova con questa macro da associare ad un pulsante (non ActiveX).
    
    Option Explicit
    
    Sub prova()
    Dim a As Range, b As Range, c As Range, d As Range
    Dim cn1 As Range, cn2 As Range, cn3 As Range, cn4 As Range
    Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer
    Dim r As Long, i As Long, j As Long, k As Long, ur As Long
    Dim num As Integer, vt As Integer
    
    Set cn1 = Range("A1:A10")
    Set cn2 = Range("B1:B10")
    Set cn3 = Range("C1:C10")
    Set cn4 = Range("D1:D10")
    Range("G1:K100").ClearContents
    For Each a In cn1
        n1 = a
        For Each b In cn2
            n2 = b
            For Each c In cn3
                n3 = c
                For Each d In cn4
                    n4 = d
                    'numero in tutte le colonne
                    If n1 = n2 And n1 = n3 And n1 = n4 Then
                        Cells(1, 7) = n1
                        GoTo NumRipet
                    End If
                Next
            Next
        Next
    Next
    NumRipet:
        'scrive tutte le colonne in colonna J
        r = 0
        For Each a In cn1
            r = r + 1
            Cells(r, 10) = a.Value
        Next
        For Each b In cn2
            r = r + 1
            Cells(r, 10) = b.Value
        Next
        For Each c In cn3
            r = r + 1
            Cells(r, 10) = c.Value
        Next
        For Each d In cn4
            r = r + 1
            Cells(r, 10) = d.Value
        Next
        'elimina doppioni
        Columns("J:J").RemoveDuplicates Columns:=1, Header:=xlNo
        ur = Cells(Rows.Count, 10).End(xlUp).Row
        'numero ripetuto e numero ripetizioni
        For i = 1 To ur
            num = Cells(i, 10).Value
            For k = 1 To 10
                For j = 1 To 4
                    If num = Cells(k, j).Value Then
                        vt = vt + 1
                    End If
                Next j
            Next k
            Cells(i, 11) = vt
            vt = 0
        Next i
    Set cn1 = Nothing
    Set cn2 = Nothing
    Set cn3 = Nothing
    Set cn4 = Nothing
    End Sub
    
    Fai sapere. Ciao,
    Mario
  • Re: Numeri in comune nelle colonne

    Ciao Marius,

    Grazie per la risposta adesso la testo e vedo di applicarla.

    Ciao
    Daniele
  • Re: Numeri in comune nelle colonne

    Marius44 ha scritto:


    Ciao
    ricordati che è sempre meglio allegare un file per "vederne" la struttura.
    Ciò premesso, ammesso che i tuoi numeri si trovino nell'intervallo A1:D10, prova con questa macro da associare ad un pulsante (non ActiveX).
    
    Option Explicit
    
    Sub prova()
    Dim a As Range, b As Range, c As Range, d As Range
    Dim cn1 As Range, cn2 As Range, cn3 As Range, cn4 As Range
    Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer
    Dim r As Long, i As Long, j As Long, k As Long, ur As Long
    Dim num As Integer, vt As Integer
    
    Set cn1 = Range("A1:A10")
    Set cn2 = Range("B1:B10")
    Set cn3 = Range("C1:C10")
    Set cn4 = Range("D1:D10")
    Range("G1:K100").ClearContents
    For Each a In cn1
        n1 = a
        For Each b In cn2
            n2 = b
            For Each c In cn3
                n3 = c
                For Each d In cn4
                    n4 = d
                    'numero in tutte le colonne
                    If n1 = n2 And n1 = n3 And n1 = n4 Then
                        Cells(1, 7) = n1
                        GoTo NumRipet
                    End If
                Next
            Next
        Next
    Next
    NumRipet:
        'scrive tutte le colonne in colonna J
        r = 0
        For Each a In cn1
            r = r + 1
            Cells(r, 10) = a.Value
        Next
        For Each b In cn2
            r = r + 1
            Cells(r, 10) = b.Value
        Next
        For Each c In cn3
            r = r + 1
            Cells(r, 10) = c.Value
        Next
        For Each d In cn4
            r = r + 1
            Cells(r, 10) = d.Value
        Next
        'elimina doppioni
        Columns("J:J").RemoveDuplicates Columns:=1, Header:=xlNo
        ur = Cells(Rows.Count, 10).End(xlUp).Row
        'numero ripetuto e numero ripetizioni
        For i = 1 To ur
            num = Cells(i, 10).Value
            For k = 1 To 10
                For j = 1 To 4
                    If num = Cells(k, j).Value Then
                        vt = vt + 1
                    End If
                Next j
            Next k
            Cells(i, 11) = vt
            vt = 0
        Next i
    Set cn1 = Nothing
    Set cn2 = Nothing
    Set cn3 = Nothing
    Set cn4 = Nothing
    End Sub
    
    Fai sapere. Ciao,
    Mario

    Ciao Ho fatto una prova con il tuo consiglio e funziona, ma devo cambiare praticamente buona parte del mio programma precedente per far sviluppare lo stesso programma.
    Credo di potercela fare

    Grazie
Devi accedere o registrarti per scrivere nel forum
3 risposte