0.5, 1.5, 2.1, 0.43, 0.35
condition/base number : 1
Result needed:
To select number nearest to 1 ie.= 0.5 by using macro.
Note: Although 1.5 is also near to 1 (also a 0.5 difference), it must choose the smaller number.
(0.5 is smaller as compared to 1.5)
Solution:
Sub FindClosest() Const CONDITION_NUMBER = 1 Const COLUMNS_OF_DATA = 7 Dim intCount As Integer Dim sngNums() As Single ReDim sngNums(COLUMNS_OF_DATA) Dim sngMinDiff As Single Dim sngTemp As Single Dim intResult As Integer Dim strTemp As String Dim lngRow As Long Dim strRow As String Dim lngBottom As Long Dim intTemp As Integer ActiveCell.SpecialCells(xlLastCell).Select lngBottom = ActiveCell.Row For lngRow = 2 To lngBottom strRow = Trim(Str(lngRow)) ' Populate an array with the differences. PURPOSE: TO REDUCE NUMBER OF LOCATIONS IN WAREHOUSE For intCount = 1 To COLUMNS_OF_DATA If intCount < 3 Then strTemp = Chr(88 + intCount) Else intTemp = (intCount - 3) / 26 strTemp = Chr(65 + intTemp) & Chr(62 + intCount - (26 * intTemp)) End If sngNums(intCount) = CONDITION_NUMBER - Range(strTemp & strRow).Value Next ' Start by finding a value that we know is not right that we can use to work our way in. ' Get the larger of the differences from the smallest and largest numbers in the source range If COLUMNS_OF_DATA < 3 Then strTemp = Chr(88 + COLUMNS_OF_DATA) Else intTemp = (COLUMNS_OF_DATA - 3) / 26 strTemp = Chr(65 + intTemp) & Chr(62 + COLUMNS_OF_DATA - (26 * intTemp)) End If sngTemp = Abs(CONDITION_NUMBER - (Application.WorksheetFunction.Max(Range("Y" & strRow & ":" & strTemp & strRow)))) sngMinDiff = Abs(CONDITION_NUMBER - (Application.WorksheetFunction.Min(Range("Y" & strRow & ":" & strTemp & strRow)))) If sngTemp > sngMinDiff Then sngMinDiff = sngTemp ' Now as we go through the numbers, we know we'll get something that's BIGGER. ' Or, if they're all the same, it won't matter which we select. intResult = 1 For intCount = 1 To COLUMNS_OF_DATA ' If the abs of the difference is smaller, collect the BIGGER number. If Abs(sngNums(intCount)) < sngMinDiff Then sngMinDiff = Abs(sngNums(intCount)) intResult = intCount End If ' If the abs of the diff is the same, but the original # is lower than the ' condition, point to that one instead. RULE OF THUMB: choose nearer to 1 but if btw 0.5 and 1.5, choose 1.5. If Abs(sngNums(intCount)) = sngMinDiff And sngNums(intCount) < 0 Then intResult = intCount End If Next If intResult < 3 Then strTemp = Chr(88 + intResult) Else intTemp = (intResult - 3) / 26 strTemp = Chr(65 + intTemp) & Chr(62 + intResult - (26 * intTemp)) End If sngTemp = range(strTemp & strRow).Value ' Now intResult holds the index of the closest number that is lower than the condition. If COLUMNS_OF_DATA = 1 Then strTemp = "Z" Else intTemp = (COLUMNS_OF_DATA - 2) / 26 strTemp = Chr(65 + intTemp) & Chr(63 + COLUMNS_OF_DATA - (26 * intTemp)) End If Range(strTemp & strRow).Formula = sngTemp Next End Sub
No comments:
Post a Comment