[英]Automatic spreadsheet generation in Excel VBA
My friend and I currently have a master spreadsheet that I need to be broken out into smaller spreadsheets regularly. 我和我的朋友目前有一个主电子表格,我需要定期将其分成较小的电子表格。 This used to be a manual process, but I'd like to automate it.
这曾经是一个手动过程,但我想自动化它。 I created a three step solution in VBA which would help me accomplish this that did the following:
我在VBA中创建了一个三步解决方案,它可以帮助我完成以下操作:
Unfortunately I am having a hard time implementing it. 不幸的是,我很难实现它。 Whenever I try to generate the spreadsheet, my document hangs, starts performs several calculations and then gives this me this error message:
每当我尝试生成电子表格时,我的文档会挂起,启动会执行多次计算,然后给我这个错误消息:
Upon debugging the code, I get an error message at this line: 调试代码后,我在此行收到错误消息:
One Excel workbook is left open and only one row is visible (the second row pulled from the Master which contains header information) and nothing else. 一个Excel工作簿保持打开状态,只有一行可见(第二行从主服务器中提取,包含标题信息),没有别的。
What exactly is going on here? 到底发生了什么?
This is my code so far: 到目前为止这是我的代码:
The heart of it all 这一切的核心
' This bit of code get's all the primary contacts in column F, it does
' this by identifying all the unique values in column F (from F3 onwards)
Sub GetPrimaryContacts()
Dim Col As New Collection
Dim itm
Dim i As Long
Dim CellVell As Variant
'Get last row value
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
'Loop between all column F to get unique values
For i = 3 To LastRow
CellVal = Sheets("Master").Range("F" & i).Value
On Error Resume Next
Col.Add CellVal, Chr(34) & CellVal & Chr(34)
On Error GoTo 0
Next i
' Once we have the unique values, apply the TOKEN NOT ACTIVATED FILTER
Call TokenNotActivated
For Each itm In Col
ActiveSheet.Range("A2:Z2").Select
Selection.AutoFilter Field:=6, Criteria1:=itm
' This is where the magic happens... creating the individual workbooks
Call TokenNotActivatedProcess
Next
ActiveSheet.AutoFilter.ShowAllData
End Sub
The "token not activated" filter “令牌未激活”过滤器
Sub TokenNotActivated()
'Col M = Yes
'Col U = provisioned
ThisWorkbook.Sheets(2).Activate
ActiveSheet.Range("A2:Z2").Select
Selection.AutoFilter Field:=13, Criteria1:="Yes"
Selection.AutoFilter Field:=21, Criteria1:="provisioned", Operator:=xlFilterValues
End Sub
Running the process to get the workbooks saved 运行该过程以保存工作簿
Function TokenNotActivatedProcess()
Dim r As Range, n As Long, itm, FirstRow As Long
n = Cells(Rows.Count, 1).End(xlUp).Row
Set r = Range("A1:A" & n).Cells.SpecialCells(xlCellTypeVisible)
FirstRow = ActiveSheet.Range("F2").End(xlDown).Row
itm = ActiveSheet.Range("F" & FirstRow).Value
If r.Count - 2 > 0 Then Debug.Print itm & " - " & r.Count - 2
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="C:\Working\Testing\TokenNotActivated - " & itm + ".xls", FileFormat:=52, CreateBackup:=False
End Function
This error is caused by trying to filter an empty range. 尝试过滤空范围会导致此错误。 After analysing your code, my guess is that you are missing a worksheet activation here, since repeating the line
ActiveSheet.Range("A2:Z2").Select
after calling the function TokenNotActivated does not make sense and maybe your code is trying to filter some empty range/worksheet. 在分析了你的代码之后,我的猜测是你在这里缺少一个工作表激活,因为重复了一行
ActiveSheet.Range("A2:Z2").Select
在调用函数后ActiveSheet.Range("A2:Z2").Select
TokenNotActivated没有意义,也许你的代码试图过滤一些空的范围/工作表。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.