簡體   English   中英

Excel VBA中自動生成電子表格

[英]Automatic spreadsheet generation in Excel VBA

我和我的朋友目前有一個主電子表格,我需要定期將其分成較小的電子表格。 這曾經是一個手動過程,但我想自動化它。 我在VBA中創建了一個三步解決方案,它可以幫助我完成以下操作:

  1. 將相關過濾器應用於電子表格
  2. 過濾到新電子表格后,導出當前可見的數據
  3. 保存電子表格並返回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").Select在調用函數后ActiveSheet.Range("A2:Z2").Select TokenNotActivated沒有意義,也許你的代碼試圖過濾一些空的范圍/工作表。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM