XL 2016 (RESOLU) Variable Tableau Données colonne en double

darkjedi · 26 Juin 2020

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.

Voici le bout de code qu'il faut que je développe:

VB:

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

patricktoulon · 27 Juin 2020

mapomme à dit:
Bonjour @patricktoulon ,

Tu payes combien ?

re tu viens de me donner la solution sur un autre post
en gros l’ébauche ça donne ça

VB:

Function getLine(F, col1$, col2$, v1, v2)
    derlig = F.Cells(Rows.Count, col1).End(xlUp).Row
    c1 = Cells(1, col1).Resize(derlig).Address(0, 0)
    c2 = Cells(1, col2).Resize(derlig).Address(0, 0)
    For I = 1 To derlig
        a = a + 1
        formule = "=IFERROR(SMALL(IF((" & c1 & "=" & v1 & ")*(" & c2 & "=" & v2 & "),ROW(" & c1 & "))," & a & "),0)"
        x = Evaluate(formule)
        If x <> 0 Then
            Debug.Print formule
            Debug.Print x
        Else
            Exit For
        End If
    Next
End Function
Sub test()
    MsgBox getLine(Feuil1, "A", "B", 1, 1)
End Sub

mapomme · 27 Juin 2020

re @patricktoulon

Bon, tu as trouvé ta solution. Tu me me paieras pas, j'en suis sûr maintenant. Tant pis !

patricktoulon · 27 Juin 2020

me reste a transformer ca en tableau ou tableau d'address et nb d'arguments dynamique

ben non il fallait annoncer le prix d'abords
t'marron dans cette histoire

patricktoulon · 27 Juin 2020

Kado

VB:

'*****************************************************************************************************
'recherche multicriteres multicolonnes
'version 2.0
'auteur:patricktoulon(Exceldownload)
'on peut mettre autant de colonnes et d'argument que l'on veut (((à hauteur du len max d'une formule)))
'chaque argument(recherche) correspond a l'item de colonnes du meme index
'basé sur la formule de @mapomme(Exceldownload)
'la récupération des lignes ne concerne que les colonnes demandées
'*****************************************************************************************************
Option Explicit

Sub testx()
    Dim Colonnes, Recherche, Feuille As Worksheet, meslignes
    Colonnes = Array("a", 3, 5)    ' les colonnes peuvent etre exprimées en numerique ou lettre(minuscule ou Majuscule)
    'Recherche = Array(1, 1, 3)    'les arguments peuvent etre string ou numeriques
    Recherche = Array(1, "TOTO", 3)    'les arguments peuvent etre string ou numeriques(Majuscule ou minuscule ne respecte pas la casse)
    Set Feuille = Feuil1 ' feuille concernée
    Set meslignes = GetRangeLine(Feuille, Colonnes, Recherche) 'get
    MsgBox "les ligne trouvées de la plage sont " & vbCrLf & meslignes.Address 'exemple d'utilisation
End Sub
exemple en piece jointe



Function GetRangeLine(F, Colonnes, arg)
    Dim a&, formule$, I&, Fml, Fr$, x, full As Range, res As Range, Derlig&
    Derlig = F.Cells(Rows.Count, Colonnes(0)).End(xlUp).Row
    ReDim Fml(UBound(Colonnes))
    Set full = F.Range(F.Cells(1, Colonnes(0)), F.Cells(Rows.Count, Colonnes(UBound(Colonnes))))
    For I = 0 To UBound(Colonnes)
        Colonnes(I) = F.Name & "!" & F.Cells(1, Colonnes(I)).Resize(Derlig).Address(0, 0)
        If Not IsNumeric(arg(I)) Then arg(I) = """" & arg(I) & """"
        Fml(I) = "(" & Colonnes(I) & "=" & arg(I) & ")"
    Next
    formule = "=IFERROR(SMALL(IF(" & Join(Fml, "*") & " ,ROW(1:" & Derlig & ")),ind),0)"
    For I = 1 To Derlig
        a = a + 1
        Fr = Replace(formule, "ind", a)
        x = Evaluate(Fr)
        If x > 0 Then
            Debug.Print Fr: Debug.Print x
            If res Is Nothing Then Set res = full.Rows(x) Else Set res = Union(res, full.Rows(x))
        Else
            Exit For
        End If
    Next
    Set GetRangeLine = res
End Function

darkjedi · 28 Juin 2020

Bonjour @mapomme @patricktoulon,

Merci à vous pour votre aide. Le code de@mapomme me sert pour mon projet en cours.
Je serais certainement amener à utiliser le code de @patricktoulon dans un autre projet qui arrive.
Ce soir je me coucherais moins bête....

XL 2016 (RESOLU) Variable Tableau Données colonne en double

darkjedi

XLDnaute Nouveau

Pièces jointes

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

darkjedi

XLDnaute Nouveau

Discussions similaires