Excel VBA中自动生成电子表格

2019年8月4日 270次阅读

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

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

不幸的是,我很难实现它.每当我尝试生成电子表格时,我的文档会挂起,启动会执行多次计算,然后给我这个错误消息：

调试代码后,我在此行收到错误消息：

一个Excel工作簿保持打开状态,只有一行可见(第二行从主服务器中提取,包含标题信息),没有别的.

到底发生了什么？

到目前为止这是我的代码：

这一切的核心

' 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

最佳答案 尝试过滤空范围会导致此错误.在分析了你的代码之后,我的猜测是你在这里错过了一个工作表激活,因为重复了一行ActiveSheet.Range(“A2：Z2”).调用函数后选择TokenNotActivated是没有意义的,也许你的代码试图过滤一些空的范围/工作表.

点赞