筛选不重复值复制并转置，

fengdiyelx

各位老师，例如：我想将表1里的A列 筛选不重复值 复制到表2里面的第2行，我目前只能筛选出来，但是无法转置，请帮忙指正。谢谢！

宏如下

Sub 按钮1_Click()
  Dim i%, arr
    arr = Sheets("表1").Range("a2:a" & Sheets("表1").Range("a65536").End(xlUp).Row)
    Set dic = CreateObject("scripting.dictionary")
    For i = 1 To UBound(arr)
        dic(arr(i, 1)) = ""
    Next
    Sheets("表2").Range("d2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys)
   
End Sub

请看附件，望老师赐教，谢谢！

lenghonghai601

1. 这句代码改成这样：    Sheets("表2").Range("d2").Resize(1, dic.Count) = dic.keys
   

复制代码

jiangxiaoyun

一维数组放到工作表的【一行】中，直接放就行，不需转置。

fengdiyelx

lenghonghai601 发表于 2018-7-11 07:57

您好，似乎还是不行，代码修改后输出的结果不太对，您可以试试，出来的是某一数值重复出现

fxl447098457

人家的代码只是实现横着放置数据，你的去重复代码是你的问题。