如何解决有没有一种方法可以将Excel电子表格按行值拆分为不同的文件?
我有一个很大的Excel工作表,其中包含针对不同客户的单独评估报告,这些报告都合并为一个大工作表。我需要将此巨型工作表拆分为每个客户单独的报告文件,然后转换为pdf。
我无法按行数进行拆分,因为行数差异很大。
但是,“ [SUMMARISED]”和饼图的图像出现在每个新的单独报告之前的每一行上。这意味着“ [SUMMARISED]”之前的行是断点。
我可以根据这个单词拆分此工作表中的数据吗?
Net Asset Value is the last row of the previous report,'[SUMMARISED]' is the start of a new one
'[SUMMARISED]'在A列中
解决方法
请尝试下一个代码,
Sub testSplitSheetContentSumm()
Dim sh As Worksheet,lastRow As Long,wb As Workbook,ws As Worksheet,count As Long
Dim rng As Range,strSearch As String,sumCell As Range,startRow As Long
Dim firstFAddress As String,wbName As String,k As Long,strPath As String
strSearch = "[SUMMARISED]"
Set sh = ActiveSheet ' use here your sheet
strPath = ActiveWorkbook.Path
lastRow = sh.Range("A" & Rows.count).End(xlUp).Row
Set rng = sh.Range("A1:A" & lastRow)
'for speed optimization______________________
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'____________________________________________
startRow = 1
Set sumCell = rng.Find(What:=strSearch,After:=sh.Range("A1"),LookIn:=xlValues)
If Not sumCell Is Nothing Then
firstFAddress = sumCell.Address
wbName = sumCell.Offset(2,1).Value
'correct the workbook name from ilegal characters
wbName = Replace(Replace(wbName,"/","-"),"""","")
Do
k = k + 1
If k = 1 Then GoTo Over
count = count + 1 'how many files has been saved
Set wb = Workbooks.Add: Set ws = wb.Sheets(1)
sh.Range(sh.cells(startRow,1),sh.cells(sumCell.Row - 1,sh.UsedRange.Columns.count)).Copy _
Destination:=ws.Range("A1")
startRow = sumCell.Row
'saving the workbook:
Application.DisplayAlerts = False 'to avoid the screen asking for permition to overwrite existing
wb.SaveAs strPath & "\" & wbName
Application.DisplayAlerts = True
'saving the pdf:
ws.Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF,Filename:= _
strPath & "\" & wbName & ".pdf"
wb.Close False
wbName = sumCell.Offset(2,1).Value
wbName = Replace(Replace(wbName,"")
Over:
Set sumCell = rng.FindNext(sumCell)
Loop While Not sumCell Is Nothing And sumCell.Address <> firstFAddress
'now,the last part should be saved,too:
Set wb = Workbooks.Add: Set ws = wb.Sheets(1)
sh.Range(sh.cells(startRow,sh.cells(lastRow,sh.UsedRange.Columns.count)).Copy _
Destination:=ws.Range("A1")
Application.DisplayAlerts = False
wb.SaveAs strPath & "\" & wbName
Application.DisplayAlerts = True
ws.ExportAsFixedFormat Type:=xlTypePDF,Filename:= _
strPath & "\" & wbName & ".pdf",Quality:= _
xlQualityStandard,IncludeDocProperties:=False,IgnorePrintAreas:=False
wb.Close False
Else
MsgBox "The word """ & strSearch & """ could not be found..."
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox count & " files have been saved in """ & strPath & """ folder.",_
vbInformation,"Job done..."
End Sub
已编辑:您遇到的问题是由于用于构建文件名的字符串包含回义字符而产生的。现在,代码将/
替换为-
,并删除了"
。新创建文件的保存路径将是要处理的文件的路径。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。