MS Excel 2010 - 使用 Abs() 的计算在放置在其他 VBA 中时停止工作
Posted
技术标签:
【中文标题】MS Excel 2010 - 使用 Abs() 的计算在放置在其他 VBA 中时停止工作【英文标题】：MS Excel 2010 - Calculation using Abs() stops working when placed in other VBA 【发布时间】：2014-12-23 16:28:51 【问题描述】：我编写了一个宏，将本月的 KPI 数据与上个月的等效数据进行比较，然后在每个数据旁边添加一个符号，以显示性能是更好、更差还是相同。如果数字接近 100%，性能会更好，如果离得更远，性能会更差。想要的结果是这样的：
[上月图、本月图、所需符号、备注]
示例 1 - [98,99,↑,本月的数字接近 100 因此性能有所提升]
示例 2 - [101,102,↓,距离 100 更远，因此性能更差]
示例 3 - [98,98,=,数字相同，因此性能没有变化]
示例 4 - [98,102,±,性能没有好坏之分，但上个月低于目标，本月超过目标，反之亦然，如果数字为 102,98]
当下面的代码块单独运行时，它可以正常工作：
Sub Test231214()
Range("A1").Select
checkCell = Selection.Value
Range("B1").Select
newCell = Selection.Value
'Check whether the active cell is less than, equal to or greater than the corresponding value from last month
If newCell = checkCell Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
Selection.Value = "'="
ElseIf Abs(100 - newCell) < Abs(100 - checkCell) Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
ActiveCell.Value = ChrW(&H2191)
ElseIf Abs(100 - newCell) > Abs(100 - checkCell) Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
ActiveCell.Value = ChrW(&H2193)
ElseIf Abs(100 - newCell) = Abs(100 - checkCell) Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
ActiveCell.Value = "±"
End If
End Sub
但当相同的代码用作更大宏的一部分时，它不会：
Sub Populate_KPI_Arrows()
'
' Populate_KPI_Arrows Macro
' Opens dialogue box to select last month's KPI file, compares values and inserts arrows as appropriate.
'
'IF AN ERROR IS GENERATED AT ANY POINT DURING THE EXECUTION OF THIS MACRO THEN GO TO THE ERROR HANDLING CLAUSE
'NB: Disabled for now to make sure it is executing correctly
'On Error GoTo ErrorHandler
'SECTION 1 - CREATE NECESSARY VARIABLES AND SET VALUES
'CREATE VARIABLES FOR THE WORKBOOKS AND SHEETS TO BE COMPARED
Dim b1 As Workbook, b2 As Workbook, b3 As Workbook, w2 As Worksheet, w4 As Worksheet, w6 As Worksheet
'CREATE VARIABLE FOR THE PATH OF b1
Dim strFile As String
'CREATE VARIABLES FOR THE ARRAY OF COLUMNS TO EXAMINE AND THE INDEX OF THE CURRENT ARRAY ITEM
Dim hoursArray As Variant
Dim x As Integer
'SET ARRAYS OF COLUMNS TO EXAMINE
hoursArray = Array("B")
'TURN OFF SCREEN UPDATING TO PREVENT WORKINGS BEING DISPLAYED
Application.ScreenUpdating = False
'SET b1 AS THE WORKBOOK THIS MACRO WAS RUN FROM, strFile AS THE WORKBOOKS FILE PATH w1 AS 'Schemes KPIs' TAB & w2 AS 'Villages KPIs' TAB
Set b1 = ActiveWorkbook
strFile = ActiveWorkbook.FullName
Set w2 = ActiveWorkbook.Sheets("Villages KPIs")
'TEMPORARILY CLOSE THIS MONTHS WORKBOOK
Application.DisplayAlerts = False
b1.Close
Application.DisplayAlerts = True
'OPEN A DIALOG BOX TO SELECT LAST MONTHS FILE
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Select last month's Combined KPI's file"
.InitialFileName = "C:\"
'IF A FILE IS SELECTED THEN OPEN IT
If .Show = -1 Then
pubInputFile = .SelectedItems(1)
txtFile = pubInputFile
Workbooks.Open (txtFile)
'SET b2 AS SELECTED FILE, w4 AS 'Villages KPIs' TAB
Set b2 = ActiveWorkbook
Set w4 = ActiveWorkbook.Sheets("Villages KPIs")
'ELSE THE USER PRESSED CANCEL SO EXIT MACRO
Else
Exit Sub
End If
End With
'UNPROTECT 'Villages KPIs' TAB OF LAST MONTHS WORKBOOK
w4.Activate
ActiveSheet.Unprotect Password:="password"
'COPY LAST MONTHS DATA TO A NEW TEMPORARY WORKBOOK, SET NEW WORKBOOK AS b3
w4.Activate
Cells.Select
Selection.Copy
Workbooks.Add
Set b3 = ActiveWorkbook
'SET w6 TO THE SHEET WITH THE DATA FROM w4
w4.Activate
Cells.Select
Selection.Copy
b3.Activate
Sheets.Add After:=Sheets(Sheets.Count)
Set w6 = ActiveSheet
ActiveSheet.Paste
'CLOSE LAST MONTHS WORKBOOK
Application.DisplayAlerts = False
b2.Close SaveChanges:=False
Application.DisplayAlerts = True
'REOPEN THIS MONTHS WORKBOOK
If InStr(strFile, "\") = 0 Then
Exit Sub
End If
Workbooks.Open Filename:=strFile
'RESET b1, w2 TO THE VALUES THAT THEY WERE BEFORE
Set b1 = ActiveWorkbook
Set w2 = ActiveWorkbook.Sheets("Villages KPIs")
'UNPROTECT 'Schemes KPIs' & 'Villages KPIs' TABS OF THIS MONTHS WORKBOOK
w2.Activate
ActiveSheet.Unprotect Password:="password"
'SECTION 2 - SELECT w2 AND THEN RUN THE FOR LOOP ON EACH COLUMN TO BE EXAMINED
'SELECT COLUMN A OF THE 'Villages KPIs' TAB IN THIS MONTHS WORKBOOK
w2.Activate
Range("A:A").Select
'COUNT THE NUMBER OF LOCATIONS ON THE CURRENT TAB
LastLocation = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 15
'LOOP THROUGH ALL ITEMS OF hoursArray
For x = LBound(hoursArray) To UBound(hoursArray)
'LOOP THROUGH ALL ARROW CELLS FOR CURRENT COLUMN AND INSERT RELEVANT ARROW OR EQUALS SIGN
For a_counter = 10 To LastLocation + 9
'SELECT CELL XY WHERE X IS THE CURRENT ARRAY ITEM AND Y IS THE CURRENT VALUE OF a_counter
w6.Activate
w6.Range(hoursArray(x) & a_counter).Select
checkCell = Selection.Value
w2.Activate
w2.Range(hoursArray(x) & a_counter).Select
newCell = Selection.Value
'Check whether the active cell is less than, equal to or greater than the corresponding value from last month
If (100 - checkCell) < 0 Then
checkCell = (checkCell * -1)
End If
If (100 - newCell) < 0 Then
newCell = (newCell * -1)
End If
If newCell = checkCell Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
Selection.Value = "'="
ElseIf (Abs(100 - newCell)) < (Abs(100 - checkCell)) Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
ActiveCell.Value = ChrW(&H2191)
ElseIf (Abs(100 - newCell)) > (Abs(100 - checkCell)) Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
ActiveCell.Value = ChrW(&H2193)
ElseIf (Abs(100 - newCell)) = (Abs(100 - checkCell)) Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
ActiveCell.Value = "±"
End If
Next a_counter
'SELECT CELL XZ WHERE X IS THE CURRENT ARRAY ITEM AND Z IS THE ROW 2 BELOW THE LAST LOCATION
w6.Activate
w6.Range(hoursArray(x) & LastLocation + 11).Select
checkCell = Selection.Value
w2.Activate
w2.Range(hoursArray(x) & LastLocation + 11).Select
newCell = Selection.Value
'Check whether the active cell is less than, equal to or greater than the corresponding value from last month
If (100 - checkCell) < 0 Then
checkCell = (checkCell * -1)
End If
If (100 - newCell) < 0 Then
newCell = (newCell * -1)
End If
If newCell = checkCell Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
Selection.Value = "'="
ElseIf (Abs(100 - newCell)) < (Abs(100 - checkCell)) Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
ActiveCell.Value = ChrW(&H2191)
ElseIf (Abs(100 - newCell)) > (Abs(100 - checkCell)) Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
ActiveCell.Value = ChrW(&H2193)
ElseIf (Abs(100 - newCell)) = (Abs(100 - checkCell)) Then
'Select the cell to the right of the current selection
Selection.Offset(0, 1).Select
ActiveCell.Value = "±"
End If
Next x
'PROTECT 'Villages KPIs' TAB OF THIS MONTHS WORKBOOK
w2.Activate
ActiveSheet.Protect Password:="password", DrawingObjects:=False, Contents:=True, Scenarios:= _
False
'CLOSE TEMPORARY WORKBOOK WITHOUT SAVING
Application.DisplayAlerts = False
b3.Close SaveChanges:=False
Application.DisplayAlerts = True
'TURN SCREEN UPDATING BACK ON SO ARROWS APPEAR
Application.ScreenUpdating = True
Exit Sub
'Error handler
ErrorHandler:
Resume Next
End Sub
当作为较大宏的一部分运行时，对于超过 100 的数字，它会使箭头方向错误。任何想法为什么会发生这种情况或有更好的方法吗？也欢迎任何关于整理代码的 cmets。
附加信息：这些工作簿中还有其他列，如果数字上升，箭头始终指向上方，并且类似的代码块不使用 Abs() 并且直接比较 newCell 和 checkCell 对这些列工作正常在更大的宏中。
【问题讨论】：
您能否缩小您的问题范围，删除不相关的部分并突出显示实际问题（与标题相关，仅显示 Abs() 函数的问题，而不是所有“箭头”等） ?谢谢和问候， 我将建议您首先检查您的代码和REMOVE ALL SELECT 引用。这将清除错误参考的可能性。然后报告具体哪条线路没有工作更清楚。 【参考方案1】：令人尴尬的问题是“100 -”本应为“1 -”，因为被比较的值以百分比格式存储为小数。感谢您的回复，我将确保观察 pnuts 未来分享的最佳实践文档的“最小”方面，同样的一点是 Alex Bell 提出的公平竞争。避免 Select 引用的指南也非常有用，因此将来也会采用。
【讨论】：
以上是关于MS Excel 2010 - 使用 Abs() 的计算在放置在其他 VBA 中时停止工作的主要内容，如果未能解决你的问题，请参考以下文章
ms excel 2010 中用于获取环境变量用户名的用户定义函数不起作用