字典后输出优化

一壶鱼

字典后输出了。如果某列没有数据，输出有问题，怎么解决。另外多列怎么合并成一列（工作表“数据”）

LIUZHU

写的很繁琐，描述下，你的要求是什么？

一壶鱼

1、我在工作表名称“一层”，已经做好了合并汇总，把它输出到了工作表名称“数据”下了。但是在工作表名称“一层”中C、H、M、T、Z列不输入数据的话，程序报错。优化一下这个
2、输出到工作表名称“数据”下的数据能多列变两列吗？一列名称，一列数字。然后按照每列28行填在工作表名称“室内装潢1”下，29-56行填在工作表名称“室内装潢2”下...按顺序放

WANT-T

祝工作顺利天天开心

一壶鱼

没的办法(ˇˍˇ） 想～哇，哎

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim ws As Worksheet
   
5.     Dim rng As Range
   
6.     Dim d As Object
   
7.     Set d = CreateObject("scripting.dictionary")
   
8.     For Each aa In Array("一层", "二层")
   
9.         With Worksheets(aa)
   
10.             For Each bb In Array("b4:q57", "s4:w24", "y4:ac24", "y27:ac47")
    
11.                 arr = .Range(bb)
    
12.                 For i = 4 To UBound(arr)
    
13.                     For j = 2 To UBound(arr, 2) Step 5
    
14.                         If Len(arr(i, j)) <> 0 Then
    
15.                             If Not d.exists(aa) Then
    
16.                                 Set d(aa) = CreateObject("scripting.dictionary")
    
17.                             End If
    
18.                             If Not d(aa).exists(bb) Then
    
19.                                 Set d(aa)(bb) = CreateObject("scripting.dictionary")
    
20.                             End If
    
21.                             d(aa)(bb)(arr(i, j)) = d(aa)(bb)(arr(i, j)) + arr(i, j + 1)
    
22.                         End If
    
23.                     Next
    
24.                 Next
    
25.             Next
    
26.         End With
    
27.     Next
    
28.     With Worksheets("数据")
    
29.         .UsedRange.Offset(1, 0).Clear
    
30.         r = 2
    
31.         For Each aa In d.keys
    
32.             For Each bb In d(aa).keys
    
33.                 ReDim crr(1 To d(aa)(bb).Count, 1 To 2)
    
34.                 m = 0
    
35.                 For Each cc In d(aa)(bb).keys
    
36.                     m = m + 1
    
37.                     crr(m, 1) = cc
    
38.                     crr(m, 2) = d(aa)(bb)(cc)
    
39.                 Next
    
40.                 With .Cells(r, 1)
    
41.                     .Value = Switch(bb = "b4:q57", aa, bb = "s4:w24", "厨房间", bb = "y4:ac24", "卫生间1", bb = "y27:ac47", "卫生间2")
    
42.                     .Resize(1, 2).Merge
    
43.                     .Interior.ColorIndex = 15
    
44.                 End With
    
45.                 .Cells(r + 1, 1).Resize(UBound(crr), UBound(crr, 2)) = crr
    
46.                 With .Cells(r, 1).Resize(1 + UBound(crr), 2)
    
47.                     .Borders.LineStyle = xlContinuous
    
48.                     .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
    
49.                     With .Font
    
50.                         .Name = "微软雅黑"
    
51.                         .Size = 10
    
52.                     End With
    
53.                 End With
    
54.                 r = r + 1 + UBound(crr)
    
55.             Next
    
56.         Next
    
57.         With .UsedRange
    
58.             .HorizontalAlignment = xlCenter
    
59.             .VerticalAlignment = xlCenter
    
60.         End With
    
61.     End With
    
62. End Sub
    
63. 
    

复制代码

chxw68

看了楼主的代码才看明白。

一壶鱼

chxw68 发表于 2023-4-20 15:17
看了楼主的代码才看明白。

我只能按照最笨的方法一个一个弄了，大神另外能不能输出的数据按照我的工作表“室内装潢1”的表格类型生成多页，保证28行汇总一次。

一壶鱼

实际上我就是这个目的，前面输入数据，后面自动生成固定表格，最好是把项目放进去，不是生成

zxsea_7426

重新写完代码，刷新发现好多回复，高手就是多啊。