为什么运算一次结果就会重复增加一次数据到表里？求大神帮忙看一下

nouce

为什么运算一次结果就会重复增加一次数据到表里？而且是成倍数增加到表里，求大神帮忙看一下



Sub 价格统计表()
Dim a, b, c, d, i, j
Dim arr, brr, crr
Dim dic
arr = Sheets("BOM表").[a1].CurrentRegion
Set dic = CreateObject("scripting.dictionary")
Sheets("价格统计表").Range("a1").AutoFilter
For a = 8 To UBound(arr, 2) Step 4
    i = arr(1, a) & arr(2, a) & arr(3, a) & arr(4, a)
    dic(i) = Array(arr(6, a + 1), arr(6, a + 3))
Next
ReDim crr(1000, 6)
brr = Sheets("价格统计表").[a1].CurrentRegion
For b = 2 To UBound(brr)
    j = brr(b, 1) & brr(b, 2) & brr(b, 3) & brr(b, 4)
    If dic.exists(j) Then
        brr(b, 5) = dic(j)(0)
        brr(b, 6) = dic(j)(1)
    Else
        c = c + 1
        For d = 1 To 6
            crr(c - 1, d - 1) = brr(b, d)
        Next
    End If
Next
Sheets("价格统计表").[a:q].NumberFormat = "@"
Sheets("价格统计表").[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
Sheets("价格统计表").Cells(UBound(brr) + 1, 1).Resize(c, 6) = crr
Sheets("价格统计表").Range("a1").AutoFilter
End Sub

shiruiqiang

Sheets("价格统计表").Cells(UBound(brr) + 1, 1).Resize(c, 6) = crr
应该UBound(brr) + 1在加上去。新手路过

liulang0808

建议楼主上传测试附件
可以先检查下，表格赋值区域的数值，是否需要先清空，再赋值给数组处理？

nouce

liulang0808 发表于 2023-5-18 07:12
建议楼主上传测试附件
可以先检查下，表格赋值区域的数值，是否需要先清空，再赋值给数组处理？

我测试的时候，又出现新的问题了，我把之前的数据删除后，再运算，后面新增加的计算不出来，这个地方不知道怎么修改

nouce

shiruiqiang 发表于 2023-5-18 07:07
Sheets("价格统计表").Cells(UBound(brr) + 1, 1).Resize(c, 6) = crr
应该UBound(brr) + 1在加上去。新手 ...

怎么加法？

nicleyuan

nouce 发表于 2023-5-18 09:12
怎么加法？

参考3楼

高个子

你这个c没有清空吧，在开始的地方设置c的初值就可以了

liulang0808

nouce 发表于 2023-5-18 09:01
我测试的时候，又出现新的问题了，我把之前的数据删除后，再运算，后面新增加的计算不出来，这个地方不知 ...

楼主还是上传下附件吧

nouce

liulang0808 发表于 2023-5-18 10:10
楼主还是上传下附件吧

麻烦看一下吧，应该是代码写错了

nouce

确定是这个地方写错了，不应该这样做，但又不知道怎样写比较好，麻烦大神看一下