请哪位大神帮忙解决一个找重复值并提取数据的问题，我试过VBA，技术实在不照，感谢

shibom

[url=][/url]

3190496160

Sub test()
Set d = CreateObject("scripting.dictionary")
With ActiveSheet
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    ar = .Range("a1:ac" & r)
    ReDim arr(1 To UBound(ar), 1 To UBound(ar, 2))
    For i = 1 To UBound(ar)
        n = n + 1: jj = 0: d.RemoveAll
        br = .Range(.Cells(i, 1), .Cells(i, "ac"))
        For j = 2 To UBound(ar, 2)
            If Trim(br(1, j)) <> "" Then
                d(Trim(br(1, j))) = d(Trim(br(1, j))) + 1
            End If
        Next j
        For Each k In d.keys
            If d(k) > 1 Then
                jj = jj + 1
                arr(n, jj) = k
            End If
        Next k
    Next i
    .[aj1].Resize(n, UBound(arr, 2)) = arr
End With
End Sub

3190496160

提取数据.rar (28.27 KB, 下载次数: 6)

2020-3-24 09:33 上传

点击文件名下载附件

shibom

3190496160 发表于 2020-3-24 09:32
Sub test()
Set d = CreateObject("scripting.dictionary")
With ActiveSheet

大神就是大神，结果很快就出来了，我自己学VBA，天天上网看各位大神帖子，之前怎么都弄不出来，感谢感谢

shibom

3190496160 发表于 2020-3-24 09:32
Sub test()
Set d = CreateObject("scripting.dictionary")
With ActiveSheet

感谢 这位前辈上次的帮助，我想请教一下如何能将提取出来的5到6位数单独列出来，因为是要处理一行里面的多个单元格，貌似很复杂，或者是将提取出来的数据中五位数以下的数据都删除，请问前辈这样要如何写代码呢，麻烦前辈有空余的时间帮我看看这个问题，或者麻烦前辈帮我写一下代码，我自己会好好研究一下，十分感谢