Astuces Excel
  1. Astuces Excel
  3. Excel VBA – Éliminer les duplicates d'affilée
Intereting Posts
Excel: searchz toutes les valeurs d'une list qui correspond à une autre list dans le cadre d'une déclaration COUNTIFS Formule IF avec plusieurs conditions Générer un rapport Excel séparé par des virgules – Affiche en une seule colonne comment copyr et coller datatables d'une colonne à l'autre entre deux feuilles de classur Excel … sans écraser le contenu de la colonne de destination …? Formule Aspose ayant un problème de changement d'index de colonne Recherche bidirectionnelle avec lists de données dans Excel Est-il possible de tirer une valeur d'un classur Excel fermé, dont le nom est choisi en fonction d'une valeur dans la feuille de travail actuelle Erreur VBA traitant le problème avec des cellules vierges Java Poi XSSF – crée un tableau pivot avec plusieurs colonnes extensibles Transposer toutes les 2 colonnes à la nouvelle ligne Code Python non sorti Trouvez des valeurs non existantes dans Excel entre deux colonnes Comment transmettre la valeur de la date actuelle au comptage inférieur Dans la fonction SUMIFS, j'obtiens l'erreur #VALUE Pourquoi cette tentative de création d'un tableau croisé dynamic (Excel Interop) échoue-t-elle?

Excel VBA – Éliminer les duplicates d'affilée

Bonsoir,

J'ai lu les publications précédentes et je n'ai pas trouvé de réponse à ce problème particulier.

J'ai un script VBA dans Excel qui renvoie des valeurs en A2, B2, C2, puis il exécute une boucle pour remplir datatables en A3, B3, C3 etc.

Ce que je dois faire, c'est éliminer les valeurs dupliquées dans la ligne en utilisant VBA et renvoyer uniquement les valeurs uniques. Je délimite l'utilisation du "/".

Il faut ignorer les cellules vierges.

L'idée est que les résultats sont calculés avant la prochaine boucle.

Idéalement, je souhaiterais seulement afficher le résultat sans avoir à remplir A1, B1, C1 etc.

Exemples de données

Votre aide est appréciée. 

'Conditions If Cells(rw, 24) = Cells(rw, 26) And Cells(rw, 24) = Cells(rw, 25) Then Cells(rw, 18) = "'" & Cells(rw, 24) If Cells(rw, 24) <> Cells(rw, 26) Then Cells(rw, 18) = Cells(rw, 24) & "/" & Cells(rw, 26) Cells(rw, 20) = Application.VLookup(Cells(rw, 18), Workbooks("CMF Export.xlsx").Sheets("Data").Columns("C:D"), 2, False) ' Vlookup function If Not aCell Is Nothing Then Cells(rw, 23 + i) = Right(aCell.Value, 7) End If

    Essayez d'utiliser la Collection pour stocker des valeurs uniques: 

     Sub test() Dim col As Collection Dim r As Range, c As Range Dim res As Ssortingng, lastrow As Long, el 'change sheet name to suit With ThisWorkbook.Worksheets("Sheet1") 'Find last non empty row in column A lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 'add text format to column E .Range("E2:E" & lastrow).NumberFormat = "@" 'iterates through each row For Each r In .Range("A2:C" & lastrow).Rows 'initialize collection Set col = New Collection 'iterates through each cell in row For Each c In r.Cells 'next lines adds only unique values On Error Resume Next col.Add CStr(c.Value), CStr(c.Value) On Error GoTo 0 Next 'collect result res = "" For Each el In col res = res & el & "/" Next If res <> "" Then res = Left(res, Len(res) - 1) 'write result in column E .Range("E" & r.Row).Value = res 'adding VLOOKUP (follow up from comments) 'With .Range("F" & r.Row) 'adjust Sheet1!A1:C100 to suit your needs ' .Formula = "=VLOOKUP(" & res & ",Sheet1!A1:C100,3,0)" 'next line rewrites formula with formula result ' .Value = .Value 'End With Set col = Nothing Next End With End Sub

    RÉSULTAT:

    entrez la description de l'image ici