求大神帮助，字典去重时是准确的，遍历所有表格就出错

dnvjfdeuff

求大神帮助，字典去重时是准确的，遍历所有表格就出错

ykcbf1100

这句错了吧，左右应该一致。

3190496160

Private Sub CommandButton1_Click()
Set d = CreateObject("scripting.dictionary") '字典后期绑定
Dim sht As Worksheet
r = 0
Dim brr()
ReDim brr(1 To 50000, 1 To 3)
For Each sht In Worksheets
    If sht.Name <> "你好" Then
    arr = sht.UsedRange
        For j = 4 To UBound(arr)
            If arr(j, 7) <> "" Then
                If d.exists(arr(j, 7)) Then
                    x = d(arr(j, 7))
                    brr(x, 2) = brr(x, 2) + 1
                    brr(x, 3) = brr(x, 3) + arr(j, 9)
                Else
                    r = r + 1
                    brr(r, 1) = arr(j, 7)
                    brr(r, 2) = 1
                    brr(r, 3) = arr(j, 9)
                    d(arr(j, 7)) = r
                End If
            End If
        Next
    End If
Next
If r > 0 Then
    Range("k2").Resize(r, 3) = brr
End If
End Sub

Private Sub CommandButton2_Click()
Set d = CreateObject("scripting.dictionary") '字典后期绑定
Dim sht As Worksheet
r = 0
arr = Sheet1.UsedRange
Dim brr()
ReDim brr(1 To UBound(arr), 1 To 3)
For j = 4 To UBound(arr)
    If arr(j, 7) <> "" Then
    If d.exists(arr(j, 7)) Then
        x = d(arr(j, 7))
        brr(x, 2) = brr(x, 2) + 1
        brr(x, 3) = brr(x, 3) + arr(j, 9)
    Else
        r = r + 1
        brr(r, 1) = arr(j, 7)
        brr(r, 2) = 1
        brr(r, 3) = arr(j, 9)
        d(arr(j, 7)) = r
        
    End If
    End If
Next

If r > 0 Then
    Range("a2").Resize(r, 3) = brr
End If
End Sub

3190496160

字典调试.rar (24.89 KB, 下载次数: 5)

2022-11-30 11:11 上传

点击文件名下载附件

3190496160

代码的整体思路是不错的，但是，楼主犯了一个致命的错误：你是把数据源区域复制给arr数组的，但是，你又在arr数组中存储遍历的结果数组，正确的做法应该是重新定义一个新的数组来存在结果，

dnvjfdeuff

3190496160 发表于 2022-11-30 11:13
代码的整体思路是不错的，但是，楼主犯了一个致命的错误：你是把数据源区域复制给arr数组的，但是，你又在a ...

谢谢，我试一下

dnvjfdeuff

3190496160 发表于 2022-11-30 11:13
代码的整体思路是不错的，但是，楼主犯了一个致命的错误：你是把数据源区域复制给arr数组的，但是，你又在a ...

感谢大神的帮助