我为Excel编写了一个宏，用于将数据从一个内部文件填充到外部月度报告中。按原样，90-95％的时间，它完美地运作。但是，我偶尔发现，它似乎将原始文件中的方程式转换为值，这迫使我必须在运行下个月的报告之前修复所有方程式。
代码（如下）通过从内部报告运行并打开最新的外部报告（或用户选择的报告）来工作。在两个报告中，都有匹配的命名范围。宏然后遍历命名范围并将外部报告的范围设置为等于内部报告范围的值。
目前，我通过几乎相同的内部报告每月填写客户报告大约15次，尽管我竭尽所能，但我似乎无法复制问题。它似乎有时会这样做，而不是其他人。我通常甚至都没有发现原来的公式一直持续到下个月（不过，现在我更加关注潜在的问题）。
我读过如果Excel将范围从一个Excel实例复制到另一个实例，它可能会导致原始方程为set to values，但我不相信我的代码应该创建单独的Excel实例，并且当我添加一个代码试图在第二个实例启动时发出警告时，它似乎没有解决问题。有没有人遇到过类似的问题，或者有没有人知道可能会发生什么（无论是如何重现或修复它？）。
谢谢你的帮助。
仅供参考：我在Windows 7上运行Excel 2010.此外，这些文件托管在共享驱动器上，因此未运行本地计算机。
Option Explicit
Dim wbSeoReport As Workbook 'Internal workbook
Dim wbClientReport As Workbook 'workbook for clients
Dim sSeoReportName As String
Dim sClientFileName As String 'wbClientReport Name
Dim sFilePath As String 'Folder containing this file
Sub Populate_Client_File()
Dim replace_page As Worksheet
Dim sCompanyName As String 'Client company name
Dim sClientFileNameAndPath As String 'wbClientReport Name and path for opening file
'These are used to find the most recent version (date is this month or last, version is the highest available, starting at 10)
Dim iClientFileMonth As Integer
Dim iOriginalMonth As Integer
Dim iClientFileYear As Integer
Dim iClientFileVersion As Integer
Dim sClientFileVersion As String 'this is used to add the v to the client version as iClientFileVersion iterates from 10-1
Dim objFileDialog As FileDialog 'This is for selecting a file when the user does not want the most recent
Dim iUserInput As Integer 'Used to decide whether the most recent file will be used or not.
Dim bFileExists As Boolean
Dim bStayInLoop As Boolean
Dim x As Long, z As Long
Dim labels(1 To 1000) As String
Set wbSeoReport = ThisWorkbook
If ExcelInstances > 1 Then 'This checks the instances of Excel, which could be an issue making formulas saving as values.
MsgBox "There are " & str(ExcelInstances) & " instances of Excel open. Please close extra instances and start again."
Exit Sub
End If
sFilePath = ActiveWorkbook.path & "\"
iUserInput = MsgBox("Would you like to use the most recent file?", vbYesNoCancel) 'Results returned as integers: 6 is yes, 7 is no, 2 is cancel
If iUserInput = 6 Then
'The following code seeks to identify the most recent client file based on month and file version
'it then checks if it is open, opens it, and sets the file as wbClientReport
iClientFileMonth = Month(wbSeoReport.Worksheets("Traffic Summary").range("S1").value)
iOriginalMonth = iClientFileMonth 'This is used for only running the file finder once.
iClientFileYear = Year(wbSeoReport.Worksheets("Traffic Summary").range("S1").value) - 2000
sCompanyName = wbSeoReport.Worksheets("Traffic Summary").range("Z1").value
bFileExists = False
bStayInLoop = True
'This loop is used to go through this month and the previous.
'If it fails, you can select the report to open.
Do While bStayInLoop = True
For iClientFileVersion = 10 To 0 Step -1
'This loops through file versions starting at 10.
If iClientFileVersion > 0 Then
sClientFileVersion = " v" & iClientFileVersion
Else
sClientFileVersion = ""
End If
sClientFileNameAndPath = sFilePath & sCompanyName & " - MOM - Client Report " & iClientFileYear & " - " & iClientFileMonth _
& sClientFileVersion & ".xlsm"
sClientFileName = sCompanyName & " - MOM - Client Report " & iClientFileYear & " - " & iClientFileMonth _
& sClientFileVersion & ".xlsm"
bFileExists = IsFile(sClientFileNameAndPath)
If bFileExists = True Then
bStayInLoop = False
Exit For
'GoTo exitLoop
End If
Next iClientFileVersion
If bStayInLoop = True Then
If iOriginalMonth - 1 = 0 And iClientFileMonth - 1 = 0 Then
iClientFileMonth = 12
iClientFileYear = iClientFileYear - 1
ElseIf iClientFileMonth = iOriginalMonth Then
iClientFileMonth = iClientFileMonth - 1
Else
iUserInput = 7 'Allows user to find file.
bStayInLoop = False
End If
End If
Loop
'This sets an opened file (or opens it) to the wbClientReport
If bFileExists = True Then
If BookOpen(sClientFileName) = True Then
Set wbClientReport = Workbooks(sClientFileName)
Else
Set wbClientReport = Workbooks.Open(sClientFileNameAndPath)
End If
End If
End If
If iUserInput = 7 Then
'This allows a user to select their own file.
Set objFileDialog = Application.FileDialog(msoFileDialogOpen)
With objFileDialog
.InitialFileName = sFilePath
.AllowMultiSelect = False
.Show
On Error Resume Next
sClientFileName = Dir(.SelectedItems.Item(1))
.Execute
End With
'This sets an opened file (or opens it) to the wbClientReport
Set wbClientReport = Workbooks(sClientFileName)
ElseIf iUserInput = 6 Then
'Do nothing. Work has already been done.
Else
'User pressed cancel
GoTo EndOfCode
End If
sSeoReportName = wbSeoReport.name
If ExcelInstances > 1 Then 'This checks the instances of Excel, which could be an issue making formulas saving as values.
MsgBox "There are " & str(ExcelInstances) & " instances of Excel open. Please close extra instances and start again."
Exit Sub
End If
'This code calls the function that sets the named ranges equal to each other to populate
'the data from the SEO Report to the Client Report
Populate_Client_Template
'This makes errors = 0 to look better for clients.
For Each replace_page In wbClientReport.Worksheets
replace_page.Cells.Replace what:="#DIV/0!", Replacement:="0", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next
EndOfCode:
Application.ScreenUpdating = True
End Sub
Private Sub Populate_Client_Template()
Dim replace_page As Worksheet
Dim label As String 'Used to identify one label in a named range.
Dim labels(1 To 1000) As String 'Used to store all of the named range labels.
Dim x As Long, z As Long 'x keeps track of the entry number in labels. z is a loop iterator.
Dim rngTitleRange As range
x = 0
labels(x + 1) = "Branded_Keywords"
x = x + 1
labels(x + 1) = "Conversion_Rate_by_Source"
x = x + 1
'...
'This adds about 30 more names of the named ranges to the array "labels" to be iterated through in the following loop.
On Error Resume Next
For z = 1 To x + 1
Fill_Client_Report (labels(z)) 'Uses function to populate Client Report with data.
Fill_Client_Report (labels(z) & "_Titles") 'Uses function to populate named ranges that have title info (ie column a in 13 month window).
Next z
End Sub
Sub Fill_Client_Report(label As String)
Dim wsClient_Page As Worksheet 'This is used to select the page on which a named range exists in the client report
Dim wsSeo_Page As Worksheet 'This is used to select the page on which a named range exists in the SEO Report
Dim rngTestRange As range 'This is used to check if a named range exists in the respective documents.
wbSeoReport.Activate
On Error Resume Next
Set rngTestRange = range(label)
If Not rngTestRange Is Nothing Then 'This checks if the named range exists in the SEO Report
Set wsSeo_Page = range(label).parent 'This sets the page containing the named range.
wbClientReport.Activate
Set rngTestRange = range(label)
If Not rngTestRange Is Nothing Then 'This checks if the named range exists in the Client Report
Set wsClient_Page = range(label).parent 'This sets the page containing the named range.
'The following sets the two ranges equal to populate the client report with seo report data.
wsClient_Page.range(label).value = wsSeo_Page.range(label).value
Else
'This shows is the named range isn't in the client report.
Debug.Print label
End If
Else
'This shows if the named range isn't in the seo report.
Debug.Print label
End If
End Sub
Function IsFile(fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
On Error Resume Next
IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function
Function BookOpen(strBookName As String) As Boolean
'This code checks if a workbook is open
Dim Bk As Workbook
On Error Resume Next
Set Bk = Workbooks(strBookName)
On Error GoTo 0
If Bk Is Nothing Then
BookOpen = False
Else
BookOpen = True
End If
End Function
答案 0 :(得分：1)
通过使用函数获取带有工作簿参数和范围名称的命名范围，可以使代码更加健壮。
E.g：
Sub Tester()
Dim rng As Range
Set rng = GetNamedRange(ActiveWorkbook, "TESTER2")
If Not rng Is Nothing Then
Debug.Print rng.Parent.Name, rng.Address
Else
Debug.Print "Range not found!"
End If
End Sub
'returns the range for "theName", or Nothing if not found
Function GetNamedRange(wb As Workbook, theName As String)
Dim rv As Range
On Error Resume Next 'ignore a specific error
Set rv = ActiveWorkbook.Names("TESTER2").RefersToRange
On Error GoTo 0 'stop ignoring errors
Set GetNamedRange = rv
End Function
如果可能，您应该从代码的其余部分删除On Error Resume Next：如果 要使用它，请确保尽快将其关闭。
如果您可以合理地预期它们可能出现在正常操作中并且您可以在案例之后测试错误，则忽略特定错误是可以的，但您不应忽略批发错误。