|
不好意思,这些工作我每天做,这段间较忙,不能直接帮你,把我做好的代码发给大家看吧,看懂之后这个问题就解决了,这段代码你应该能用,试试吧 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 | 
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2007-12-11 09:43
楼主