Discussion :

[jpvba]

Bonjour Eric,

J'ai tâtonner avec le isArray en essayant de trouvé avec quoi je pouvais remplacer le code dans le cas que la réponse était négative mais en vain (je ne maîtrise pas encore le language assez). Je comprends que 1 item n'Est pas considéré comme un Array mais je ne vois pas comment faire pour by passer. Oui je vois que c'Est un if isarray ce que l'on avait mais le else, j'ai aucune idée malheureusement

J'ai lu le tutoriel par notre ami silkyroad mais on dit comment utiliser les variables tableaux mais je ne vois pas d'astuce comment contourner mon problème.


Comme artifice j'ai ajouté 1 a mon appel pour le range de plListe et plDest et cela fonctionne . Cependant ce n'Est pas optimal si je réutilise le code et j'oublie cette situation de la seul et unique donnée.

Donc il est sur que je veux optimiser le tout et de ce fait apprendre encore plus ce langage qui m'est très utile quotidiennement dans mon travail.


merci pour votre aide et de vos "enseignements"

[eriiic]

Bonjour,

je voyais ça comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub concat2(plListe As Range, plageRech As Range, plageRecup As Range, plDest As Range)
    Dim rech, recup, liste
    Dim dict, lig As Long
 
    rech = plageRech.Value
    recup = plageRecup.Value
    liste = plListe.Value
    Set dict = CreateObject("Scripting.Dictionary")
    For lig = 1 To UBound(rech)
        If dict.exists(rech(lig, 1)) Then
            dict(rech(lig, 1)) = dict(rech(lig, 1)) & vbLf & recup(lig, 1)
        Else
            dict(rech(lig, 1)) = recup(lig, 1)
        End If
    Next lig
    If IsArray(liste) Then
        For lig = 1 To UBound(liste)
            liste(lig, 1) = dict(liste(lig, 1))
        Next lig
        plDest = liste
    Else
        plDest = dict(plListe.Value)
    End If
End Sub

eric

[jpvba]

merci mille fois Éric !!!!

[eriiic]

Tchin !

[jpvba]

Encore moi ... oui je sais

J'ai dans certaines situation auquel j'ai plusieurs données retournée et j'Aimerais avoir la valeur une seule et unique fois . Par exemple au lieu d'avoir chat, chat, chat je vais avoir chat comme valeur retourner.


J'utilisais un code a la fin pour faire ce travail mais cela alourdit de façon considérable la procédure.

Donc il y aurais-t-il une façon de faire pour également "pimper" le code que tu as créé afin de répondre cette dite situation ???


Je laisse le code que j'Avais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub suprimedoublons_feuille()
    Dim dico, c As Range
    Dim k As Variant
    Dim tablo As Variant
    Dim item As Variant
 
    Application.ScreenUpdating = False
 
    Set dico = CreateObject("Scripting.Dictionary")
 
    On Error Resume Next
 
    For Each c In ActiveSheet.UsedRange 'UsedRange donne les coordonnées des cellules utilisées au maximum ligne et colonne
      If c <> "" And InStr(1, c, Chr(10), vbTextCompare) <> 0 Then 'instr donne la position de chr(10) sinon 0
        tablo = Split(c, Chr(10))
        For Each item In tablo
            item = Application.Trim(item)
            dico.Add item, ""
        Next item
        c = ""
        For Each k In dico.keys
            c = c & Chr(10) & k 'construction d'une chaîne de valeurs avec chr(10) comme separateur
        Next                    'MAIS AU DEBUT!
        c = Right(c, Len(c) - 1) 'Donc suppression du premier caractère (chr(10)!)
           'on vide le dico en entier
        dico.RemoveAll
      End If
    Next c
    Set dico = Nothing
End Sub

ainsi que le code de épart avec cette fonction intégrer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Function rmultUnique(valeurachercher As Variant, plageachercher As Range, numcolonne As Long) As String
    Dim u As Variant
    Dim nb As Long
    Dim boucle As Long
    Dim tabval() As Variant
    Dim i As Variant
    Dim J As Variant
    ReDim tabval(plageachercher.Rows.Count)
 
    nb = 1
    u = ""
 
    For boucle = 1 To plageachercher.Rows.Count
        If plageachercher(boucle, 1) = valeurachercher Then
            tabval(nb) = plageachercher(boucle, numcolonne)
            nb = nb + 1
        End If
    Next boucle
 
 
    For i = 1 To nb - 1
        For J = i + 1 To nb - 1
            If tabval(i) = tabval(J) Then tabval(J) = ""
        Next J
    Next i
 
    For i = 1 To nb
        If tabval(i) <> "" Then u = u & tabval(i) & Chr(10)
 
    Next i
 
    If Right$(u, 1) = Chr(10) Then u = Left$(u, Len(u) - 1)
 
    rmultUnique = u

merci mille fois !!!!

[eriiic]

Bonjour,

pas sûr d'avoir compris.
Ca ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub concat(plListe As Range, plageRech As Range, plageRecup As Range, plDest As Range)
    Dim rech, recup, liste
    Dim dict, lig As Long
 
    rech = plageRech.Value
    recup = plageRecup.Value
    liste = plListe.Value
    Set dict = CreateObject("Scripting.Dictionary")
    For lig = 1 To UBound(rech)
        If dict.exists(rech(lig, 1)) Then
            If InStr(vbLf & dict(rech(lig, 1)) & vbLf, vbLf & recup(lig, 1) & vbLf) = 0 Then
                dict(rech(lig, 1)) = dict(rech(lig, 1)) & vbLf & recup(lig, 1)
            End If
        Else
            dict(rech(lig, 1)) = recup(lig, 1)
        End If
    Next lig
    If IsArray(liste) Then
        For lig = 1 To UBound(liste)
            liste(lig, 1) = dict(liste(lig, 1))
        Next lig
        plDest = liste
    Else
        plDest = dict(plListe.Value)
    End If
End Sub

eric

[jpvba]

Tu es un dieu