重复单元格的地址连接提取，跪求大神帮忙修改一下代码

十五的星星

砂海 发表于 2022-11-24 19:10
单次的去除了
=============================
Sub 统计3()

运行了，提示下标越界，点调试进来，这句代码标黄了，不知道咋回事。

砂海

十五的星星 发表于 2022-11-24 20:15
运行了，提示下标越界，点调试进来，这句代码标黄了，不知道咋回事。

① 这个值是否 超过 10 了, 如果重复超过8次 , 就放不下了 , brr(    ,  1 to 10 ) 的 10 要更大 .

② 看不到你表格结构 , 不知道② 是否合适 , 当初 用 like "*月" 就是为了控制范围, 现在只是排除了一张工作表, 不能判断是否是你预想的范围

十五的星星

砂海 发表于 2022-11-24 21:16
① 这个值是否 超过 10 了, 如果重复超过8次 , 就放不下了 , brr(    ,  1 to 10 ) 的 10 要更大 .

...

好的，我自己把这个值修改了再试试，谢谢指点。

哥儿-

参与一下
Sub test()
    Dim vArr, brr, crr, dic As Object, sht As Worksheet
    Dim i&, j&, num&, str, m&
    Set dic = CreateObject("scripting.dictionary")
    ReDim brr(1 To 10000, 1 To 3)
    For Each sht In Sheets
        If sht.Name <> "Sheet1" Then
            vArr = sht.Range("A1").CurrentRegion
            For i = 2 To UBound(vArr)
                For j = 1 To UBound(vArr, 2)
                    str = Trim(vArr(i, j))
                    If Len(str) Then
                        If Not dic.exists(str) Then
                            num = num + 1
                            dic(str) = num
                        End If
                        brr(dic(str), 1) = vArr(i, j)
                        brr(dic(str), 2) = brr(dic(str), 2) + 1
                        brr(dic(str), 3) = brr(dic(str), 3) & "/" & sht.Name & "!" & sht.Cells(i, j).Address(0, 0)
                    End If
                Next j
            Next i
        End If
    Next sht
    ReDim vArr(1 To 10000, 1 To 2)
    Sheet1.UsedRange.Offset(1).Clear
    For i = 1 To UBound(brr)
        If brr(i, 2) > 1 Then
            m = m + 1
            vArr(m, 1) = brr(i, 1)
            vArr(m, 2) = brr(i, 2)
            crr = Split(brr(i, 3), "/")
            For j = 1 To UBound(crr)
                Sheet1.Hyperlinks.Add anchor:=Sheet1.Cells(m + 1, j + 2), Address:="", SubAddress:=crr(j), TextToDisplay:=crr(j)
            Next j
        End If
    Next i
    Sheet1.Range("A2").Resize(UBound(vArr), 2) = vArr
    MsgBox "OK"
End Sub

十五的星星

我把10改成了200了。也还是那句报错。提示越界
这个工作薄的工作表的名字是没有规律的，所以不能用月来控制范围，只要排除这个查询工作表就可以了。总共有10几个工作表，就这个查询工作表是刚新建的。
所有工作表内容都在A列。
A列的内容也都是汉字，有的甚至一个单元格几十个汉字。
B列都是没数据的
练习的那个表，用你的代码去筛选3个字的名字是没有问题的
但是到筛选上万条文本内容就不行了。

十五的星星

哥儿- 发表于 2022-11-24 22:49
参与一下
Sub test()
    Dim vArr, brr, crr, dic As Object, sht As Worksheet

你的修改的最完美。