Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2390|回复: 2

[已解决]把Sheet2中A列的数据,生成到Sheet1中A列,不显示重复项

[复制链接]
发表于 2017-7-15 16:57 | 显示全部楼层 |阅读模式
本帖最后由 cpl275538 于 2017-7-17 11:35 编辑

例如:Sheet2     A1=北京   A2=上海  A3=北京  A4=上海  A4=重庆  A5=北京
生成:Sheet1     A1=北京   A2=上海  A3=重庆  
尽量使用VBA,非常感谢!
最佳答案
2017-7-15 18:27
  1. Sub tt()
  2.     Dim d, i%, arr
  3.     Set d = CreateObject("scripting.dictionary")
  4.     With Sheet2
  5.         arr = .Range("a1", .Cells(Rows.Count, 1).End(3))
  6.     End With
  7.     For i = 1 To UBound(arr)
  8.         If Len(arr(i, 1)) Then d(arr(i, 1)) = ""
  9.     Next
  10.     Sheet1.Range("a1").Resize(d.Count) = Application.Transpose(d.keys)
  11. End Sub
复制代码

模板3.rar

7.05 KB, 下载次数: 9

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-7-15 18:27 | 显示全部楼层    本楼为最佳答案   
  1. Sub tt()
  2.     Dim d, i%, arr
  3.     Set d = CreateObject("scripting.dictionary")
  4.     With Sheet2
  5.         arr = .Range("a1", .Cells(Rows.Count, 1).End(3))
  6.     End With
  7.     For i = 1 To UBound(arr)
  8.         If Len(arr(i, 1)) Then d(arr(i, 1)) = ""
  9.     Next
  10.     Sheet1.Range("a1").Resize(d.Count) = Application.Transpose(d.keys)
  11. End Sub
复制代码

评分

参与人数 1 +1 收起 理由
cpl275538 + 1 很给力,感谢

查看全部评分

回复

使用道具 举报

发表于 2017-7-15 20:25 | 显示全部楼层
我晚來,但也來一個
  1. Sub Sa()
  2. Dim lw As Long
  3. Dim d As Object
  4. Dim arr, brr
  5. Dim i%, m%

  6. Set d = CreateObject("scripting.dictionary")
  7. arr = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row)

  8. ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
  9. For i = 1 To UBound(arr)
  10.     If arr(i, 1) <> "" Then
  11.         If Not d.exists(arr(i, 1)) Then
  12.             m = m + 1
  13.             d(arr(i, 1)) = m
  14.             brr(m, 1) = arr(i, 1)
  15.         End If
  16.     End If
  17. Next i

  18. Worksheets("Sheet1").Range("b1").Resize(UBound(brr, 1)) = brr
  19. Set d = Nothing
  20. End Sub
复制代码

评分

参与人数 1 +1 收起 理由
cpl275538 + 1 赞一个,感谢

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 18:00 , Processed in 0.279748 second(s), 16 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表