[已解决]不让新建的工作表汇总

salt

请dsmch老师帮忙修改一下代码，怎样让新建的表不汇总，非常感谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2015-9-13 05:12

1. Sub Macro1()
   
2. Dim arr, brr, d, d2, d3, i&, j&, s&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary") '材料大类
   
5. Set d3 = CreateObject("scripting.dictionary")
   
6. ReDim brr(1 To 6000, 1 To 12)
   
7. [a4:l20000].Clear
   
8. w = Array("10kV清册表", "配变清册表", "0.4kV清册表", "0.22kV清册表", "户表清册表")
   
9. For i = 0 To UBound(w)
   
10.     arr = Sheets(w(i)).Range("a1").CurrentRegion
    
11.     For j = 4 To UBound(arr)
    
12.         If Not IsNumeric(arr(j, 1)) And Not d2.exists(arr(j, 2)) Then n = n + 1: d2(arr(j, 2)) = n
    
13.         If d2.exists(arr(j, 2)) Then fj = d2(arr(j, 2))
    
14.         zf = arr(j, 2) & "," & arr(j, 3) & "," & fj
    
15.         If Not d.exists(zf) Then
    
16.             s = s + 1
    
17.             d(zf) = s
    
18.             brr(s, 2) = arr(j, 2)
    
19.             brr(s, 3) = arr(j, 3)
    
20.             brr(s, 4) = arr(j, 4)
    
21.             brr(s, i + 5) = arr(j, 5)
    
22.             brr(s, 11) = arr(j, 9)
    
23.             brr(s, 12) = fj
    
24.             If Not d3.exists(fj) Then
    
25.                 n2 = n2 + 1:   d3(fj) = 0
    
26.                 brr(s, 1) = Replace(Application.Text(n2, "[dbnum1]"), "一十", "十")
    
27.             Else
    
28.                 d3(fj) = d3(fj) + 1
    
29.                 brr(s, 1) = d3(fj)
    
30.             End If
    
31.         Else
    
32.             s2 = d(zf)
    
33.             brr(s2, i + 5) = brr(s2, i + 5) + arr(j, 5)
    
34.         End If
    
35.     Next
    
36. Next
    
37. '合计
    
38. For i = 1 To s
    
39.     hj = 0
    
40.     For j = 5 To 9
    
41.         hj = hj + brr(i, j)
    
42.     Next
    
43.     brr(i, 10) = hj
    
44. Next
    
45. With Range("a4").Resize(s, 12)
    
46.     .Value = brr
    
47.     .Sort [l4], Header:=xlGuess
    
48.     .Borders.LineStyle = xlContinuous
    
49. End With
    
50. [l:l].Clear
    
51. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, d2, d3, i&, j&, s&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary") '材料大类
   
5. Set d3 = CreateObject("scripting.dictionary")
   
6. ReDim brr(1 To 6000, 1 To 12)
   
7. [a4:l20000].Clear
   
8. w = Array("10kV清册表", "配变清册表", "0.4kV清册表", "0.22kV清册表", "户表清册表")
   
9. For i = 0 To UBound(w)
   
10.     arr = Sheets(w(i)).Range("a1").CurrentRegion
    
11.     For j = 4 To UBound(arr)
    
12.         If Not IsNumeric(arr(j, 1)) And Not d2.exists(arr(j, 2)) Then n = n + 1: d2(arr(j, 2)) = n
    
13.         If d2.exists(arr(j, 2)) Then fj = d2(arr(j, 2))
    
14.         zf = arr(j, 2) & "," & arr(j, 3) & "," & fj
    
15.         If Not d.exists(zf) Then
    
16.             s = s + 1
    
17.             d(zf) = s
    
18.             brr(s, 2) = arr(j, 2)
    
19.             brr(s, 3) = arr(j, 3)
    
20.             brr(s, 4) = arr(j, 4)
    
21.             brr(s, i + 5) = arr(j, 5)
    
22.             brr(s, 11) = arr(j, 9)
    
23.             brr(s, 12) = fj
    
24.             If Not d3.exists(fj) Then
    
25.                 n2 = n2 + 1:   d3(fj) = 0
    
26.                 brr(s, 1) = Replace(Application.Text(n2, "[dbnum1]"), "一十", "十")
    
27.             Else
    
28.                 d3(fj) = d3(fj) + 1
    
29.                 brr(s, 1) = d3(fj)
    
30.             End If
    
31.         Else
    
32.             s2 = d(zf)
    
33.             brr(s2, i + 5) = brr(s2, i + 5) + arr(j, 5)
    
34.         End If
    
35.     Next
    
36. Next
    
37. '合计
    
38. For i = 1 To s
    
39.     hj = 0
    
40.     For j = 5 To 9
    
41.         hj = hj + brr(i, j)
    
42.     Next
    
43.     brr(i, 10) = hj
    
44. Next
    
45. With Range("a4").Resize(s, 12)
    
46.     .Value = brr
    
47.     .Sort [l4], Header:=xlGuess
    
48.     .Borders.LineStyle = xlContinuous
    
49. End With
    
50. [l:l].Clear
    
51. End Sub

复制代码

salt

dsmch 发表于 2015-9-13 05:12

非常感激dsmch老师，谢谢dsmch帮我解决这个难题。