不好意思,这些工作我每天做,这段间较忙,不能直接帮你,把我做好的代码发给大家看吧,看懂之后这个问题就解决了,这段代码你应该能用,试试吧 Public Sub 加数据到缓存表(源数据文件名 As String) '含扩展名, dim 缓存表 as worksheet set 缓存表=worksheets.add 缓存表.Cells.Clear Set 源数据工作簿 = Workbooks.Open(ThisWorkbook.Path & "\" & 源数据文件名, ReadOnly:=True) Dim 当前工作表 As Worksheet Dim 数据区 As Range Dim 缓存表数据行数 As Long Dim 开始粘贴行 As Long For Each 当前工作表 In 源数据工作簿.Worksheets Set 数据区 = 返回数据区(当前工作表) 数据区.Columns(4).Value = 当前工作表.Name 数据区.Copy 缓存表数据行数 = 缓存表.Cells.CurrentRegion.Rows.Count If 缓存表数据行数 = 1 Then 开始粘贴行 = 1 Else 开始粘贴行 = 缓存表数据行数 + 1 End If 缓存表.Cells(开始粘贴行, 1).PasteSpecial Next Application.CutCopyMode = False 源数据工作簿.Close False End Sub Private Function 分析表头位置(待分析表 As Worksheet,Optional 表头标志 as string ="38号") As Long '分析标志为"38号" Dim 当前行数据量 As Long Dim ii As Long For ii = 1 To 50 当前行数据量 = WorksheetFunction.CountA(待分析表.Rows(ii)) If 当前行数据量 > 8 Then Dim 可变化上限 As Long 可变化上限 = 当前行数据量 Dim jj As Long For jj = 1 To 可变化上限 Select Case 待分析表.Cells(ii, jj) Case "": 可变化上限 = 可变化上限 + 1 Case 表头标志: 分析表头位置 = ii Exit Function End Select Next End If Next 分析表头位置 = 1 End Function Private Function 分析表尾位置(待分析表 As Worksheet,Optional 表尾标志 as string ="合计") '分析标志为"合计" 待分析表.Cells.CurrentRegion.Replace " ", "" 待分析表.Cells.CurrentRegion.Replace " ", "" Dim 表头位置 As Long 表头位置 = 分析表头位置(待分析表) Dim 待分析表行数 As Long 待分析表行数 = 待分析表.Cells(表头位置 + 4, 1).End(xlDown).Row Dim 待分析表列数 As Long 待分析表列数 = 待分析表.Cells(表头位置 + 4, 1).CurrentRegion.Columns.Count Dim ii As Long Dim jj As Long For ii = 待分析表行数 To 1 Step -1 For jj = 1 To 待分析表列数 If 待分析表.Cells(ii, jj) = 表尾标志 Then 分析表尾位置 = ii - 1 Exit Function End If Next Next 分析表尾位置 = 待分析表行数 End Function Public Function 分析首行数据位置(待分析表 As Worksheet) As Long 分析首行数据位置 = 分析表头位置(待分析表) + 2 '2为第一行数据和表头差的行数 End Function Public Function 返回数据区(待分析表 As Worksheet, Optional 是否返回表头 As Boolean = False) As Range Dim 开始行号 As Long If 是否包含表头 Then 开始行号 = 分析表头位置(待分析表) Else 开始行号 = 分析首行数据位置(待分析表) End If Dim 结束行号 As Long 结束行号 = 分析表尾位置(待分析表) Dim 数据列数 As Long 数据列数 = 待分析表.Cells(分析首行数据位置(待分析表), 1).CurrentRegion.Columns.Count Set 返回数据区 = Range(待分析表.Cells(开始行号, 1), 待分析表.Cells(结束行号, 数据列数)) End Function |