Variable Tableau Données colonne en double

Bonsoir,

Je suis à la recherche d'une solution pour le problème qui se présente à moi.

J'aimerais vérifier dans 1 colonne définie d'une variable tableau que chaque valeur contenue dans cette colonne ne le soit qu'en double

Voici un début de code mais celui-ci fait ligne 1 avec ligne 2 ensuite ligne 3 avec la ligne 4 mais pas ligne 1 avec l'ensemble des lignes de l'array.

De plus cela ne prend en compte que si le témoin est seul et non s'il est répété plus de 2 fois.

La colonne F est la colonne à vérifier. La colonne J est le résultat attendu de la macro.

Merci pour votre aide.

Option Explicit

Dim m As Integer
Dim dernLigneSerie As Long
Dim tabControleSerie() As Variant
Dim controleTemoinSerieDouble As Boolean

Sub VerifTemoinsEnDouble()

    'definition tableau SERIE
    dernLigneSerie = Range("F" & Rows.Count).End(xlUp).Row
    tabControleSerie = Sheets("Feuil1").Range("F2:J" & dernLigneSerie).Value

    For m = LBound(tabControleSerie, 1) To UBound(tabControleSerie, 1)
        controleTemoinSerieDouble = False
        If tabControleSerie(m, 1) = tabControleSerie(m + 1, 1) Then
            controleTemoinSerieDouble = True
            m = m + 1
        End If

        If controleTemoinSerieDouble = False Then
            tabControleSerie(m, 4) = "témoin seul"
        End If
    Next m

    'Transfère les éléments du tableau dans la feuille de calcul
    Sheets("Feuil2").Range("A16").Resize(UBound(tabControleSerie, 1), UBound(tabControleSerie, 2)) = tabControleSerie

End Sub

Lien image (plus explicite) : https://ibb.co/rtwmVY8

Bonjour,

Une proposition à adapter.

Cdlt.

Sub VerifTemoinsEnDouble()
Dim i As Long, dernLigneSerie As Long, Occurence As Long
Dim rng As Range
Dim tabControleSerie() As Variant
    'definition tableau SERIE
    With Worksheets("Feuil1")
        dernLigneSerie = .Range("F" & Rows.Count).End(xlUp).Row
        Set rng = .Range("F2:F" & dernLigneSerie)
        tabControleSerie = .Range("F2:I" & dernLigneSerie).Value
    End With
    For i = LBound(tabControleSerie, 1) To UBound(tabControleSerie, 1)
        Occurence = WorksheetFunction.CountIf(rng, tabControleSerie(i, 1))
        Select Case Occurence
            Case 1: tabControleSerie(i, 4) = "1 témoin"
            Case 2: tabControleSerie(i, 4) = "2 témoins"
            Case Else: tabControleSerie(i, 4) = ">2 témoins"
        End Select
    Next i
    'Transfère les éléments du tableau dans la feuille de calcul
    Sheets("Feuil2").Range("A16").Resize(UBound(tabControleSerie, 1), UBound(tabControleSerie, 2)) = tabControleSerie
End Sub

Bonjour @Jean-Eric,

Le code fonctionne très bien. Il me donne le résultat désiré. Et je te remercie.

Il est totalement dans l'esprit de ce que je recherchais.

J'ai juste modifier cette ligne de code pour que cela corresponde à mes besoins.

avant:

Case 2: tabControleSerie(i, 4) = "2 témoins"

après:

Case 2: tabControleSerie(i, 4) = ""

Je vais pouvoir m'inspirer de ton travail pour comparer les valeurs de mes témoins en double 2 à 2 pour vérifier qu'il n'y a pas d’écart supérieure à 0.3 entre eux.

Est-il possible de l'effectuer dans cette même routine car les témoins en doubles sont déjà identifiés ?

Encore une fois merci