老师们给看看这个按条件汇总的问题

ykcbf1100

其实，工作表可以用代码来全选。标题行数也可以用代码自动选择。
象你这种，汇总表可以全部自动生成，字段都不用去设置。

WANT-T

开发思路：
1、搭建数据库，将多个工作簿的数据按不同类型的sheet的分别入库；--搭建入库管理的程序
2、前后端（后端数据前端动态报表）分离，搭建报表体系；
3、特殊的报表，设计单独的查询检索界面；
推荐方案：
vba+ado+sql
开发难度：
取决于你的数据标准化程度，标准化程度越高，难度越低；
复杂的问题简单化，简单问题标准化，标准的问题程序化，程序的问题自动化；
祝工作顺利

llwwll

ykcbf1100 发表于 2024-9-29 09:20
其实，工作表可以用代码来全选。标题行数也可以用代码自动选择。
象你这种，汇总表可以全部自动生成，字段 ...

新手，你们说的话和附件的表要存起来慢慢研究，不然弄不明白。

llwwll

WANT-T 发表于 2024-9-29 10:01
开发思路：
1、搭建数据库，将多个工作簿的数据按不同类型的sheet的分别入库；--搭建入库管理的程序
2、 ...

谢谢，纯新手，现在就想着用自己能理解的方式能实现功能，慢慢学习。

ykcbf1100

llwwll 发表于 2024-9-29 10:05
新手，你们说的话和附件的表要存起来慢慢研究，不然弄不明白。

汇总表自动生成，汇总所有表

附件供参考。。。

ykcbf1100

汇总所有表

1. Sub ykcbf2()    '//2024.9.29    汇总表自动生成
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     p = ThisWorkbook.Path & ""
   
6.     Set sh = ThisWorkbook.Sheets("汇总")
   
7.     sh.Cells.Clear
   
8.     ReDim brr(1 To 100000, 1 To 100)
   
9.     m = 1: n = 0
   
10.     For Each f In fso.GetFolder(p).Files
    
11.         If LCase(f.Name) Like "*.xls*" Then
    
12.             If InStr(f, "~$") = 0 Then
    
13.                 If InStr(f, ThisWorkbook.Name) = 0 Then
    
14.                     Set wb = Workbooks.Open(f, 0)
    
15.                     fn = fso.GetBaseName(f)
    
16.                     For Each sht In wb.Sheets
    
17.                         n = n + 1
    
18.                         With sht
    
19.                             r = .Cells(Rows.Count, 1).End(3).Row
    
20.                             c = .Cells(1, "XFD").End(1).Column
    
21.                             arr = .[a1].Resize(r, c)
    
22.                             Max = IIf(Max < c, c, Max)
    
23.                             If n = 1 Then
    
24.                                 brr(1, 1) = "工作簿名"
    
25.                                 brr(1, 2) = "工作表名"
    
26.                                 For j = 1 To UBound(arr, 2)
    
27.                                     brr(1, j + 2) = arr(1, j)
    
28.                                 Next
    
29.                             End If
    
30.                             For i = 2 To UBound(arr)
    
31.                                 m = m + 1
    
32.                                 brr(m, 1) = fn
    
33.                                 brr(m, 2) = .Name
    
34.                                 brr(m, 3) = m
    
35.                                 For j = 2 To UBound(arr, 2)
    
36.                                     brr(m, j + 2) = arr(i, j)
    
37.                                 Next
    
38.                             Next
    
39.                         End With
    
40.                     Next
    
41.                     wb.Close 0
    
42.                 End If
    
43.             End If
    
44.         End If
    
45.     Next
    
46.     With sh
    
47.         .UsedRange.Clear
    
48.         .[a1].Resize(1, Max + 2).Interior.Color = 49407
    
49.         With .[a1].Resize(m, Max + 2)
    
50.             .Value = brr
    
51.             .Borders.LineStyle = 1
    
52.             .HorizontalAlignment = xlCenter
    
53.             .VerticalAlignment = xlCenter
    
54.         End With
    
55.     End With
    
56.     Set d = Nothing
    
57.     Application.ScreenUpdating = True
    
58.     MsgBox "OK！"
    
59. End Sub
    

复制代码

llwwll

ykcbf1100 发表于 2024-9-29 10:19
汇总所有表

这个挺好的，还有点问题想请教，想要根据工作表名称统计的原因是每个工作簿里面有几百个工作表，有些表的格式会有点问题，按照工作表名称小范围统计比较好确定那些格式有问题，可以自己修改一下，如果按照给定工作表9.25/9.26/9.27来汇总数据的话，有可能这三张表头都是在A1的这行，有可能在A2的这行，所以功能上就又有一个分标题所在行 ，再问一个老师你上面发的代码是默认标题所在行是第一行，如果标题所在行在第二行改哪个代码啊，我修改了几次都报错，麻烦草爷了

ykcbf1100

llwwll 发表于 2024-9-29 13:55
这个挺好的，还有点问题想请教，想要根据工作表名称统计的原因是每个工作簿里面有几百个工作表 ...

你这个附件，标题行就在第一行，如果你想改到第二行，这个代码要修改，有几个地方要改。建议你上传相应附件看一下。

llwwll

想通过这个表实现，

llwwll

ykcbf1100 发表于 2024-9-29 14:38
你这个附件，标题行就在第一行，如果你想改到第二行，这个代码要修改，有几个地方要改。建议你上传相应附 ...

Sub ykcbf2()    '//2024.9.29    汇总表自动生成
    Application.ScreenUpdating = False
    Set d = CreateObject("Scripting.Dictionary")
    Set fso = CreateObject("Scripting.FileSystemObject")
    p = ThisWorkbook.Path & ""
    Set sh = ThisWorkbook.Sheets("汇总")
    sh.Cells.Clear
    ReDim brr(1 To 100000, 1 To 100)
    m = 1: n = 0
    For Each f In fso.GetFolder(p).Files
        If LCase(f.Name) Like "*.xls*" Then
            If InStr(f, "~$") = 0 Then
                If InStr(f, ThisWorkbook.Name) = 0 Then
                    Set wb = Workbooks.Open(f, 0)
                    fn = fso.GetBaseName(f)
                    For Each sht In wb.Sheets
                        n = n + 1
                        With sht
                            r = .Cells(Rows.Count, 1).End(3).Row
                            c = .Cells(1, "XFD").End(1).Column
                            arr = .[a1].Resize(r, c)
                            Max = IIf(Max < c, c, Max)
                            If n = 1 Then
                                brr(1, 1) = "工作簿名"
                                brr(1, 2) = "工作表名"
                                For j = 1 To UBound(arr, 2)
                                    brr(1, j + 2) = arr(1, j)
                                Next
                            End If
                            For i = 2 To UBound(arr)
                                m = m + 1
                                brr(m, 1) = fn
                                brr(m, 2) = .Name
                                brr(m, 3) = m
                                For j = 2 To UBound(arr, 2)
                                    brr(m, j + 2) = arr(i, j)
                                Next
                            Next
                        End With
                    Next
                    wb.Close 0
                End If
            End If
        End If
    Next
    With sh
        .UsedRange.Clear
        .[a1].Resize(1, Max + 2).Interior.Color = 49407
        With .[a1].Resize(m, Max + 2)
            .Value = brr
            .Borders.LineStyle = 1
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    End With
    Set d = Nothing
    Application.ScreenUpdating = True
    MsgBox "OK！"
End Sub
就是这个你上面发的汇总所有表的代码，大部分表格的标题在第2行，想把他改成第二行开始汇总所有。