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

我想复制一个具有不同值的整列：string和integer。然后我想将单元格粘贴到一行中，没有重复项。例如，正如您所看到的，我有一行没有重复项。

目前，我编写了这段代码，但它花费了太多的时间，因为我必须比较行中的每个单元格，以便粘贴时不重复。 您知道有一个函数可以复制整列并在一行中通过它而不重复吗？ 谢谢

Sub宏_finale（）
设置代码=范围（“M35:M57”）“我可以在代码和变量代码之间切换
Dim code_COUNT为整数'cette变量va prendre chaque code unáun
作为整数的Dim i
作为整数的Dim computer
Dim ligne_des_编码为整数'TRES IMPORTANT=déclarer en tant qu'Integer_
sinon quand在va comperera mal细胞比较器上的应用
Dim标志作为整数“指示倾诉告密者”
标志=0
计算机=4
对于代码中的每个单元格
“MsgBox”voici le contenue de la colonne libellée“+单元格值”可提供木质素测试
flag=0’la base le code banque n’est pas repertorieée
如果单元格值为“代码”，则“重要信息：si la Cellle contient le mot代码_
在ne fait-rien上，在compare-rien汽车上，这是一个代码银行
“Remarque:c'est sensibleála casse，donc ne pas mettre code avec c minimale”
code\u courant=单元格值
对于i=4到6
如果不是表格（“coller_ici”）。单元格（1，i）。值=空，则
ligne_des_代码=板材（“coller_ici”）.单元（1，i）.值
如果结束
MsgBox“voici code courant”和code_courant
MsgBox“voici ligne des code”和ligne_des_code
如果code\u courant=ligne\u des\u code，则
flag=1'代码银行代表律师事务所_
在我的公寓里
如果结束
下一个
如果flag=0，则“不需要代码银行”，因为它是ici的合作伙伴（合作伙伴）
“在瓦东克拉尤尔
表格（“coller\u ici”）。单元格（1，compteur）。值=代码
计算机=计算机+1
如果结束
如果结束
下一个细胞
端接头

下面的所有步骤本身都很简单，而且很容易找到。请执行以下操作：

1） 查找要复制的列中的最后一行

2） 定义从列的第一行到最后一行的范围

3） 应用

Range（“yourRange”）。删除重复列：=1，标题：=xlNo

4） 再次查找最后一行

5） 重新定义新范围

6） 复制范围

7） 应用

范围（“targetRange”.Paste特殊粘贴：=xlPasteAll，操作：=xlNone，SkipBlanks:=False，转置：=True

关于手动删除副本的尝试：

---

为了找到副本，您自然地将每个项目与每个项目进行比较。这有一个与O（n^2）成比例的运行时间。如果您首先对列表进行排序，则可以复制一个项目，跳过所有相等项并转到下一个项目。Sortng有（最常见的）O（log（n）*n）和新的选择唯一性O（n）。因此，此替代方法会快得多。

此代码将获取列A中的常量，删除重复项并将结果粘贴到第1行，从单元格B1开始：

Sub JohnSmith()
    Dim r As Range

    Set r = Range("A:A").Cells.SpecialCells(2)
    r.RemoveDuplicates Columns:=1, Header:=xlNo
    r.Copy
    r(1).Offset(0, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub

之前：

及之后：

或

Option Explicit
Sub Duplicates()

    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Sheet1")
        Dim rng As Range
        For Each rng In .Range("A1", .Cells(.Rows.count, 1).End(xlUp))'substitute your range here,  .Range("M20:M1000")?
            If Not dict.exists(rng.Value) And Not IsEmpty(rng) Then
                dict.Add rng.Value, rng.Value
            End If
        Next rng
        .Range("B1").Resize(1, dict.count) = dict.keys 'substitute your output cell here   Sheets("coller_ici").Cells(1, 4)?
    End With

End Sub

你可以试试

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

---

我的射程是射程（“M20:M1000”），但当我应用您的代码时，会出现错误。错误1004当我按F8键检查问题时，以下行r出现错误。RemovedUpplicates列：=1，标题：=xlNo。错误1004：应用程序定义或对象定义error@JohnSmith请注意，在我的演示代码中，数据位于A列，由常量组成，不是公式。你的数据在我知道的列中：D，我在复制/粘贴到excel之前更改了它。我不会愚蠢地复制。我尝试了范围（“M:M”）和范围（“M20:M1000”）在你的网站上，“你的代码的图像没有帮助”它不是代码。我认为你不必知道我的单元格。答案的值。这只是一个例子。已经有4个答案仅仅因为有答案，并不意味着你不能提高问题的质量。链接中没有包括其他原因：现在每个人都有答案s单击两个链接以了解问题。这是不必要的，不管是代码还是数据。我的建议是：内联图像，最好从excel文档中复制粘贴。这更可读，可以复制，实际上为您包含的步骤更少，并且不受链接腐蚀的影响。当您有1个声誉需要添加时，这是一项义务与imgur.com的链接。我不能内联图像，因为我是一个新的FAG。我不会复制粘贴10000行的范围。我认为图像不会显示任何不能在格式良好的文本的7行内显示的内容。你不能嵌入图像是。让我们这样做，你看起来真的很忙（另外，问题也很清楚），所以我会给你一个投票权，这应该会给你必要的代表权来嵌入图片并改进问题。附录：请注意，加里的学生确实花了很大的努力来转录他的答案的图片，你本可以把他从中解救出来。@JohnSmith，有什么反馈吗？很好！只是一点：这是复制一个空单元格但这对我的工作并不重要！在法国网站上，我发现了这个非常简单的行范围（“A1:A100”）。高级筛选操作：=xlFilterCopy，CopyToRange:=工作表（“Feuil2”）。范围（“A1”）我想使用你的代码和这一行。但是我不知道如何用CopyTrangEn函数连续复制。感谢看到编辑的答案来避免空白。如果它解决了你的问题，你可以考虑把答案标记为“接受”，谢谢你，据我所知，你不能使用<

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