如何宏写出，A表重复值提取到表B，求助

wodaili · 发表于 2018-10-12 15:01

本帖最后由 wodaili 于 2018-10-12 16:58 编辑

如何宏写出，A表重复值提取到表B，求助

liulang0808 · 发表于 2018-10-12 15:36

ChDir "D:\对箱工具"
ActiveWorkbook.SaveAs Filename:="D:\对箱工具\匹配结果.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Windows("对箱宏.xlsm").Activate
Application.DisplayAlerts = True
看看是否可行吧

wodaili · 发表于 2018-10-12 15:54

liulang0808 发表于 2018-10-12 15:36
ChDir "D:\对箱工具"
ActiveWorkbook.SaveAs Filename:="D:\对箱工具\匹配结果.xlsx", FileFormat:= _ ...

1、谢谢
2、如何宏写出，A表重复值提取到表B，求助

liulang0808 · 发表于 2018-10-12 16:04

wodaili 发表于 2018-10-12 15:54
1、谢谢
2、如何宏写出，A表重复值提取到表B，求助

没有附件及具体需求说明，看不明白要做什么的

wodaili · 发表于 2018-10-12 17:05

Sub d()
Dim d As Object, arr, brr, i&, j&
Set d = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
      d(arr(i, 1)) = ""
      Else
      k = k + 1
      brr(k, 1) = arr(i, 1)
End If
Next
[b:b].ClearContents
[b1] = "重复值"
If k > 0 Then [b2].Resize(k, 1) = brr
Set d = Nothing
End Sub
这是找出重复值到同张表，如何放在不同表啊

liulang0808 · 发表于 2018-10-12 19:17

with sheets("newname")
.[b:b].ClearContents
.[b1] = "重复值"
If k > 0 Then .[b2].Resize(k, 1) = brr
Set d = Nothing
end with
表名根据自己的需求设置吧

wodaili · 发表于 2018-10-15 12:27

liulang0808 发表于 2018-10-12 19:17
with sheets("newname")
..ClearContents
. = "重复值"

1、谢谢。
2、能不能把重复的数据都复制出来，次数也统计出来啊。

liulang0808 · 发表于 2018-10-15 21:03

wodaili 发表于 2018-10-15 12:27
1、谢谢。
2、能不能把重复的数据都复制出来，次数也统计出来啊。

没有相关附件，建议楼主结合附件说明需求吧

lsc900707 · 发表于 2018-10-16 06:46

一味的让大家猜谜语，就是不愿上传附件。

wodaili · 发表于 2018-10-16 09:10

对箱工具.rar (47.43 KB, 下载次数: 1)

		自动登录	找回密码
密码			免费注册

[求助] 如何宏写出，A表重复值提取到表B，求助

评分

点评