MS Excel 2010 – 使用Abs（）计算放置在其他VBA时停止工作
我写了一个macros，比较了本月的KPI数据和上个月的相应数字，然后在每个数字旁边添加了一个符号，以表示性能是好还是差。 如果数字接近100％，性能会更好，如果距离更远，则性能会更差。 所需的结果是这样的：
[上个月的数字，本月的数字，期望的符号，注释]
例1 – [98,99，↑，这个月的数字更接近100，所以performance有所改善]
例2 – [101,102，↓，从100进一步performance更差]
例3 – [98,98，=，数字相同，所以性能没有变化]
例4 – [98,102，performance不是好或差，但上个月是低于目标，本月超过目标，反之亦然，如果数字是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 但是当相同的代码被用作更大的macros的一部分时，它不会：
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
当作为更大macros观的一部分运行时，箭头的数字超过100就会出现错误。任何想法为什么会发生这种情况，还是有更好的方法呢？ 任何关于整理代码的意见都会受到欢迎。
其他信息：这些工作簿中还有其他列，如果数字上升箭头总是指向一个类似的代码块，不使用Abs() ，只是比较newCell和checkCell直接适用于较大的这些列macros。
令人尴尬的是，问题是“100 – ”应该是“1”，因为被比较的值被存储为以百分比格式化的小数。 谢谢你们的回应，我会确保遵守今后最佳做法文件的“最低限度”方面，同样的一点Alex Bell提出如此公平的发挥。 关于避免select参考的指导也非常有用，所以将来也是如此。