尝试编写一个过程来打开工作簿并在后台完成SUMIFS并将总和值存储在变量中。完成后，变量值将添加到另一个包含表格的工作簿中。这样可以自动执行打开每个systemname工作簿和添加过滤器的手动任务，然后将SUMIFS值键入第二个工作簿。虽然， Set FromWorkbook = Workbooks.Open 行没有打开工作簿。以下是代码：
Option Explicit
Sub TestCode()
'===============================================================================================
'Description: Loops through the selected site and adds in the vulnerability totals for each _
systems
'Originally written by: Troy Pilewski
'Date: 2016-06-30
'===============================================================================================
'Declares variables
Dim ToWorkbook As Workbook, FromWorkbook As Workbook
Dim ToWorksheet As Worksheet, FromWorksheet As Worksheet
Dim WorkingRange As Range, WholeRange As Range, SystemCol As Range, SystemName As Range, _
DataRange As Range, OwnerCol As Range, CategoryCol As Range, AssetCountCol As Range
Dim VarFromWorkbook As Variant, ShipNameList() As Variant, ShipName As Variant, Owner As Variant
Dim TitleString As String, FilterName As String, CurrentSystemName As String, _
ShipNames() As String, SelectedShipName As String, Owners() As String, OwnerSelected As String
Dim LastRow As Long, ShipRow As Long, OwnerColNum As Long, CategoryColNum As Long, _
AssetCountColNum As Long
Dim StartRow As Integer, BoundCounter As Integer, MsgSelection As Integer, _
ScanFileExist As Integer, CATI As Integer, CATII As Integer, CATIII As Integer, _
CATIV As Integer
Const RowMultiplyer As Integer = 47
'-----------------------------------------------------------------------------------------------
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Set ToWorkbook = ActiveWorkbook
Set ToWorksheet = ToWorkbook.ActiveSheet
LastRow = ToWorksheet.Range("Y:Y").Find( _
What:="*", _
After:=ToWorksheet.Range("Y1"), _
LookAt:=xlByRows, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious _
).Row
'MsgBox _
' Prompt:="Y1:Y" & LastRow, _
' Title:="Ship Range"
ShipNameList = ToWorksheet.Range("Y1:Y" & LastRow).Value
For Each ShipName In ShipNameList
If Left(ShipName, 3) = "USS" Then
BoundCounter = BoundCounter + 1
End If
Next ShipName
ReDim ShipNames(BoundCounter - 1)
BoundCounter = 0
For Each ShipName In ShipNameList
If Left(ShipName, 3) = "USS" Then
ShipNames(BoundCounter) = ShipName
' Debug.Print ShipNames(BoundCounter)
BoundCounter = BoundCounter + 1
Else
' Debug.Print UBound(ShipNames())
Exit For
End If
Next ShipName
TitleString = "Select a ship..."
SelectedShipName = GetChoiceFromChooserForm(ShipNames, TitleString)
If SelectedShipName = "" Then
Exit Sub
End If
ShipRow = ToWorksheet.Range("Y:Y").Find( _
What:=SelectedShipName, _
After:=ToWorksheet.Range("Y1"), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True _
).Row
'Debug.Print ShipRow
StartRow = 14
If ShipRow > 1 Then
StartRow = (RowMultiplyer * (ShipRow - 1)) + StartRow
Else
StartRow = 14
End If
Set WorkingRange = ToWorksheet.Range("B" & StartRow & ":G" & StartRow + 38)
Set SystemCol = WorkingRange.Columns(2)
'Debug.Print WorkingRange.Address
FilterName = "Excel Files (*.xls), *.xls,Excel Files (*.xlsx), *.xlsx,All Files (*.*), *.*"
TitleString = "Scan File Selection"
ScanFileExist = MsgBox( _
Prompt:="Are there scan files to read?", _
Buttons:=vbYesNo, _
Title:=TitleString)
Do While ScanFileExist = vbYes
For Each SystemName In SystemCol.Cells
If IsError(SystemName) Then
Exit For
Else
If SystemName.Offset(0, -1) > 1 Then
MsgBox _
Prompt:=SystemName & " is marked 'Do Not Scan'", _
Title:="Do Not Scan"
GoTo NextIteration
Else
MsgSelection = MsgBox( _
Prompt:="Is there a scan file for the system: " & SystemName & "?", _
Buttons:=vbYesNo, _
Title:=TitleString)
CATI = 0
CATII = 0
CATIII = 0
CATIV = 0
If MsgSelection = vbYes Then
VarFromWorkbook = Application.GetOpenFilename( _
FileFilter:=FilterName, _
FilterIndex:=2, _
Title:=TitleString)
On Error GoTo NextIteration
Set FromWorkbook = Workbooks.Open( _
Filename:=VarFromWorkbook, _
UpdateLinks:=xlUpdateLinksNever, _
ReadOnly:=False, _
Format:=5, _
Password:="", _
WriteResPassword:="", _
IgnoreReadOnlyRecommended:="", _
Origin:="", _
Delimiter:="", _
Editable:="", _
Notify:="", _
Converter:="", _
AddToMru:="", _
Local:="", _
CorruptLoad:=xlNormalLoad)
Set FromWorksheet = FromWorkbook.Worksheets(1)
With FromWorksheet
LastRow = .Range("A:J").Find( _
What:="*", _
After:=.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious _
).Row
Set WholeRange = .Range("A2:J" & LastRow)
Set DataRange = .Range("A3:J" & LastRow)
OwnerColNum = .Range("A:J").Find( _
What:="Owner", _
After:=.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext _
).Column
CategoryColNum = .Range("A:J").Find( _
What:="CAT", _
After:=.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext _
).Column
AssetCountColNum = .Range("A:J").Find( _
What:="Not Compliant", _
After:=.Range("A1"), _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext _
).Column
DataRange.Columns(AssetCountCol).Replace _
What:="(****%)", _
Replacement:=" ", _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Owners() = Split( _
Expression:="Site,System,Investigation Req'd", _
Delimiter:=",", _
Limit:=-1, _
Compare:=vbBinaryCompare)
With WholeRange
Set OwnerCol = .Columns(OwnerColNum)
Set CategoryCol = .Columns(CategoryColNum)
Set AssetCountCol = .Columns(AssetCountColNum)
For Each Owner In Owners()
OwnerSelected = Owner
Debug.Print OwnerSelected
With WorksheetFunction
CATI = .SumIfs( _
Arg1:=AssetCountCol, _
Arg2:=OwnerCol, _
Arg3:=Owner, _
Arg4:=CategoryCol, _
Arg5:="I")
CATII = .SumIfs( _
Arg1:=AssetCountCol, _
Arg2:=OwnerCol, _
Arg3:=Owner, _
Arg4:=CategoryCol, _
Arg5:="II")
CATIII = .SumIfs( _
Arg1:=AssetCountCol, _
Arg2:=OwnerCol, _
Arg3:=Owner, _
Arg4:=CategoryCol, _
Arg5:="III")
CATIV = .SumIfs( _
Arg1:=AssetCountCol, _
Arg2:=OwnerCol, _
Arg3:=Owner, _
Arg4:=CategoryCol, _
Arg5:="IV")
End With
Debug.Print CATI
Debug.Print CATII
Debug.Print CATIII
Debug.Print CATIV
Next Owner
End With
End With
If VarFromWorkbook = "False" Then
End If
Else: MsgSelection = vbNo
MsgSelection = MsgBox( _
Prompt:="Is there Information Assurance Vulnerabilities for the system: " & SystemName & "?", _
Buttons:=vbYesNo, _
Title:=TitleString)
If MsgSelection = vbYes Then
VarFromWorkbook = Application.GetOpenFilename( _
FileFilter:=FilterName, _
FilterIndex:=2, _
Title:=TitleString)
Else: MsgSelection = vbNo
SystemName.Offset(0, 1).Value2 = CATI
SystemName.Offset(0, 2).Value2 = CATII
SystemName.Offset(0, 3).Value2 = CATIII
SystemName.Offset(0, 4).Value2 = CATIV
End If
End If
End If
End If
NextIteration:
Next SystemName
ScanFileExist = MsgBox( _
Prompt:="Are there any other scan files to read?", _
Buttons:=vbYesNo, _
Title:=TitleString)
Loop
End Sub
答案 0 :(得分：0)
管理修复该错误以找到另一个错误：修复是在UpdateLinks
之后从错误行中删除所有参数