同类组合求和，出错求助

Chiyuen

麻烦大神帮看下这段代码，是想在多个表内，进行同类组合求和，如果去掉最外层的For循环，把Sheets(l)改成常量，只操作一张表就没问题，但是我是想对每一张表执行命令，，不知道为什么会错，求助大神们

Sub count_test()


    Dim i As Integer
    Dim arrs() As Variant
    i = 1


For l = 1 To Sheets.Count

    irow = Sheets(l).Range("a65536").End(xlUp).Row
    icolumn = Sheets(l).Range("IV1").End(xlToLeft).Column
    ReDim Preserve arrs(1 To irow, icolumn - 1) '提示下标越界
    For j = 1 To irow Step 1
        strname = Cells(j, 1)
        isfind = False
        k = 0
        For k = 1 To irow
            If arrs(k, 0) = strname Then
                isfind = True
                Exit For
            End If
        Next k
        If isfind Then
            arrs(k, 1) = arrs(k, 1) + Cells(j, 2)
        Else
            arrs(i, 0) = Cells(j, 1)
            arrs(i, 1) = Cells(j, 2)
            i = i + 1
        End If
    Next j


    For k = 1 To irow
        If arrs(k, 0) <> "" Then
           Cells(k, 4) = arrs(k, 0)
           Cells(k, 5) = arrs(k, 1)
        End If
    Next k
Next
End Sub

microyip

ReDim arrs(1 To irow, icolumn - 1)

Chiyuen

microyip 发表于 2020-1-29 08:37
ReDim arrs(1 To irow, icolumn - 1)

去掉Preserve后，结果在同一页出现了两遍，另外，也没有循环动作两个表，
在第二行加入，Sheets(l).Select后，可以同时执行两个表，
但是第二个表的的结果不是从第一行开始，而是从第一个表的结果后的一行开始记录

蓝桥玄霜

数据的代码：

excel海

学下字典,简单搞定

1. Sub hb()
   
2.     Dim i, arr, n
   
3.     Dim dic
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     Dim sht As Worksheet
   
6.     For Each sht In Sheets
   
7.         If sht.Name <> "合并" Then
   
8.             For i = 1 To sht.UsedRange.Rows.count
   
9.                 If Not dic.exists(sht.Cells(i, 1).Value) Then
   
10.                     dic(sht.Cells(i, 1).Value) = sht.Cells(i, 2)
    
11.                 Else
    
12.                     dic(sht.Cells(i, 1).Value) = dic(sht.Cells(i, 1).Value) + sht.Cells(i, 2)
    
13.                 End If
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     Sheets("合并").Range("a1").Resize(dic.count) = Application.Transpose(dic.keys)
    
18.     Sheets("合并").Range("b1").Resize(dic.count) = Application.Transpose(dic.items)
    
19. End Sub

复制代码