Excel VBA 中的自动电子表格生成答案

【问题标题】：Automatic spreadsheet generation in Excel VBAExcel VBA 中的自动电子表格生成
【发布时间】：2014-05-11 17:25:52
【问题描述】：

我和我的朋友目前有一个主电子表格，我需要定期将其拆分为较小的电子表格。这曾经是一个手动过程，但我想自动化它。我在 VBA 中创建了一个三步解决方案，它可以帮助我完成以下工作：

将相关过滤器应用于电子表格
将过滤后当前可见的数据导出到新电子表格中
保存电子表格并返回到 1（不同的标准）

不幸的是，我很难实现它。每当我尝试生成电子表格时，我的文档就会挂起，开始执行几个计算，然后给我这个错误消息：

在调试代码时，我在这一行收到一条错误消息：

一个 Excel 工作簿处于打开状态，只有一行可见（从 Master 中提取的第二行包含标题信息），没有其他内容。

这里到底发生了什么？

这是我目前的代码：

一切的核心

' 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

“令牌未激活”过滤器

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

运行流程以保存工作簿

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

【问题讨论】：

错误信息中的说明不是很清楚吗？ 选择范围内的单个单元格并重试该命令。 A2:22 不是“范围内的单个单元格”。错误消息中的单词通常是有意义的。 :-)
@KenWhite - 我想选择那个范围，不是吗？目前只有第二行被保存到新工作簿中，之后我收到一条错误消息，不再保存工作簿......
@methuselah：您能否在出现错误时添加itm 的值，并向我们展示您要过滤的列表。也许您需要在调用 TokenNotActivated 之后使用 breakpoint (F9) 中断代码，并查看是否有任何行可供过滤器在循环中处理，然后尝试使用 F8 逐行调试。
我第二个问题：发生错误时itm的值是多少？我怀疑它是空的，LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row 这行可能是它为空的原因。
你的朋友是@jmb吗？

标签： vba excel

【解决方案1】：

此错误是由于尝试过滤空范围而引起的。在分析您的代码后，我的猜测是您在这里缺少工作表激活，因为在调用函数 TokenNotActivated 后重复行 ActiveSheet.Range("A2:Z2").Select 没有意义，也许您的代码正在尝试过滤一些空范围/工作表。

【讨论】：