vba - 如何复制一列的所有单元格并将其粘贴到一行中而不在VBA中重复

Question

我想复制具有不同值的整个列:字符串和整数。然后我想连续粘贴单元格，没有重复，例如，如您所见，我有一行没有重复。
column

Column become row without duplicates

暂时，我写了这段代码，但是花了很多时间，因为我必须比较行中的每个单元格，以便粘贴时不重复。
你知道一个函数可以复制一整列并将其连续传递而不重复吗？
谢谢

 Sub macro_finale()

Set codes_banques = Range("M35 :M57") ' je mets toute la colonne des codes banques dans la variable codes_banques
Dim code_courant As Integer ' cette variable va prendre chaque code un à un
Dim i As Integer
Dim compteur As Integer
Dim ligne_des_codes  As Integer ' TRES IMPORTANT = déclarer en tant qu'integer _
sinon quand on va comparer les cellules il comperera mal
Dim flag As Integer ' indicateur pour informer
flag = 0
compteur = 4


For Each cell In codes_banques

   '  MsgBox "voici le contenue de la colonne libellée " + cell.Value ' ligne test supprimable
    flag = 0 ' à la base le code banque n'est pas repertoriée
    If cell.Value <> "Code" Then ' IMPORTANT : si la cellule contient le mot code _
    on ne fait rien , on compare rien car c'est pas une code banque
    ' Remarque : c'est sensible à la casse, donc ne pas mettre code avec c miniscule
        code_courant = cell.Value



        For i = 4 To 6
            If Not Sheets("coller_ici").Cells(1, i).Value = Null Then
            ligne_des_codes = Sheets("coller_ici").Cells(1, i).Value
             End If
            MsgBox " voici code courant" & code_courant
             MsgBox " voici ligne des codes " & ligne_des_codes

             If code_courant = ligne_des_codes Then

                flag = 1 ' donc le code banque est déjà repértorié dans la feuille coller_ici _
                on ne va donc pas le rajouter dans la feuille coller_ici

            End If
        Next

       If flag = 0 Then ' donc le code banque n'est pas encore repértorié dans coller ici( dans la 1ere ligne )
       'on va donc l'ajouter
            Sheets("coller_ici").Cells(1, compteur).Value = code_courant
            compteur = compteur + 1
        End If
     End If
Next cell



End Sub

Answer 1

你可以试试

Dim cell As Range
With CreateObject("Scripting.Dictionary")
    For Each cell In Range("M20:M1000").SpecialCells(xlCellTypeConstants)
        .Item(cell.Value) = 1
    Next
    Sheets("coller_ici").Cells(1, 4).Resize(, UBound(.Items) + 1).Value = .Keys
End With