时间戳

首页 > 解决方案 > 使用快捷键打开多个工作簿

excel - 使用快捷键打开多个工作簿

问题描述

从对象列表中打开第一个工作簿后，此代码失败（没有代码运行）。这发生在之后的代码中Dim obj, rng As Range。

该代码旨在从特定列中获取值，并为数组 (MyArray) 中存在的任何值创建单独的工作簿。

我使用快捷键“Ctrl + Shift +（字母键）”来激活宏。

Sub RemoveViolationIDs()

Dim fbook As Workbook
Dim fBook2 As Workbook
Dim fpath As String
Dim lastRow As Long
Dim d As Object, c As Range, k, tmp As String
Dim fname As String
Dim fname2 As String
Dim copies As New Collection

MyArray = Array("ALTERPOINT_SBC", "FWSECADM", "ARCSIGHT_PAN_PCAP", "PANSECADM", "CPSECADM", "FSSECADM", "TP21ADMIN", "RADMON", "RADMON_NA")

lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
fname = ActiveWorkbook.Name
fSheet = ActiveSheet.Name
fpath = ActiveWorkbook.Path
Set fbook = ActiveWorkbook

Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
    
If InStr(1, fname, "swpaSumRPT", vbBinaryCompare) > 0 Then
    For fRow = lastRow To 4 Step -1
        If Not IsInArray(UCase(Cells(fRow, 2).Value), MyArray) = True Then Cells(fRow, 2).EntireRow.Delete
    Next
ElseIf InStr(1, fname, "swpaViolRPT", vbBinaryCompare) > 0 Then
    For fRow = lastRow To 4 Step -1
        If Not IsInArray(UCase(Cells(fRow, 4).Value), MyArray) = True Then Cells(fRow, 4).EntireRow.Delete
    Next
End If
ActiveWorkbook.Save
    
If InStr(1, fname, "swpaSumRPT", vbBinaryCompare) > 0 Then
    For Each fCell In ActiveSheet.Range("B4:B" & lastRow)
        fCell = UCase(Trim(fCell.Value))
        fname2 = Replace(fpath & "\" & fname, "swpaSumRPT-", "swpaSumRPT-" & fCell & "-")
        fbook.ActiveSheet.Range("A3:L3").AutoFilter , field:=2, Criteria1:="<>" & fCell, Operator:=xlFilterValues
        wbTest = ""
        wbTest = Dir(fname2)
        If wbTest = "" Then fbook.SaveCopyAs fname2
        copies.Add fname2
    Next fCell

ElseIf InStr(1, fname, "swpaViolRPT", vbBinaryCompare) > 0 Then
    For Each fCell In ActiveSheet.Range("D4:D" & lastRow)
        fCell = UCase(Trim(fCell.Value))
        fname2 = Replace(fpath & "\" & fname, "swpaViolRPT-", "swpaViolRPT-" & fCell & "-")
        fbook.ActiveSheet.Range("A3:L3").AutoFilter , field:=4, Criteria1:="<>" & fCell, Operator:=xlFilterValues
        wbTest = ""
        wbTest = Dir(fname2)
        If wbTest = "" Then fbook.SaveCopyAs fname2
        copies.Add fname2
    Next fCell

End If

Dim obj, rng As Range
    For Each obj In copies
        MsgBox ("Now Opening " & obj)
        Set fBook2 = Application.Workbooks.Open(obj)
        ' avoid header 3 rows
        Set rng = fBook2.ActiveSheet.UsedRange.Offset(3)
        ' delete visible rows
        rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
        fBook2.ActiveSheet.Range("A3:L3").AutoFilter ' remove filter
    Next obj
    
    ActiveSheet.AutoFilterMode = False

End Sub
'******
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i
For i = LBound(arr) To UBound(arr)
    If arr(i) = stringToBeFound Then
        IsInArray = True
        Exit Function
    End If
Next i
IsInArray = False

End Function

标签： excelvba

解决方案

显然，这整件事是因为我使用了快捷键“Ctrl + Shift +（字母键）”来激活宏。我不知道这会导致这样的问题。从快捷键中删除“Shift”可以解决我遇到的问题。感谢之前回答我问题的所有人。我很欣赏你的洞察力。

推荐阅读