Finding Number Inside a Cell
That being said, for the people (most likely now archive browsing folk
of this group), here are the two solutions for the problem of
extracting numbers for stuff within a cell.
Again, I'm posting these so hopefully people like me who try to use
the archives first to figure stuff out can copy/paste this into Excel
and understand it / alter it to satisfy their needs.
As the saying goes, good poets borrow, great poets steal.
--------- JLatham's SOLUTION Style -----------
Sub ReConfirmVariableVariances()
Dim TeishutsuItemRow As Long
Dim TeishutsuItemColumn As Long
Dim XTIR As Long
Dim YTIR As Long
Dim LTIR As Long
Dim SokuteiPointNumber As Long
Dim HighestPointNumber As Long
Dim ToleranceStringX As String
Dim ToleranceStringY As String
Dim ToleranceStringL As String
Dim ToleranceValueX As String
Dim ToleranceValueY As String
Dim ToleranceValuePML As String
Dim ToleranceValuePL As String
Dim ToleranceValueML As String
Dim ToleranceValueLHigh As String
Dim ToleranceValueLLow As String
Dim LValueBase As String
Dim TempLoop As Long
Const Separator1 = "/"
Const Separator2 = "±"
Const NumericCharacters = "+-0123456789."
Const MinusSign = "-"
Dim Position As Integer
' SET THE VARIABLES FOR TEISHUTSUROW AND COLUMN.
' ALSO SET PREVIOUS X,Y,L ITEM ROWS IN THE EVENT REPEATED (BLANK)
TOLERANCE ENTRY.
' SOKUTEI AND HIGHEST POINT NUMBERS SET TO 1.
TeishutsuItemRow = 3
TeishutsuItemColumn = 8
XTIR = 3
YTIR = 3
LTIR = 3
SokuteiPointNumber = 1
HighestPointNumber = 1
For TempLoop = 3 To 300
If Sheets("提出用").Cells(TempLoop, TeishutsuItemColumn + 1).Value
HighestPointNumber Then
HighestPointNumber = Sheets("提出用").Cells(TempLoop,
TeishutsuItemColumn + 1).Value
End If
Next TempLoop
' LOOP FOR ALL SOKUTEI POINTS.
Do Until SokuteiPointNumber = HighestPointNumber + 1
' RESET VALUES FOR TOLERANCES
ToleranceValueX = ""
ToleranceValueY = ""
ToleranceValuePML = ""
ToleranceValuePL = ""
ToleranceValueML = ""
' FIRST MATCH UP SOKUTEI POINT WITH ROW ON 提出用 SHEET, AND SOLVE FOR
XYL TOLERANCES.
For TempLoop = 1 To 1
If Sheets("提出用").Cells(TeishutsuItemRow, TeishutsuItemColumn +
1).Value = SokuteiPointNumber Then
' FIRST ROW SOLUTION FOR X TOLERANCE.
If Sheets("提出用").Cells(TeishutsuItemRow, TeishutsuItemColumn +
2).Value = "" Then
' DO NOTHING, THIS MEANS WE WANT DEFAULT TO BE LAST NON ""
COLUMN FOR XTIR
Else
XTIR = TeishutsuItemRow
End If
' FIRST ROW SOLUTION FOR Y TOLERANCE.
If Sheets("提出用").Cells(TeishutsuItemRow, TeishutsuItemColumn +
3).Value = "" Then
' DO NOTHING, THIS MEANS WE WANT DEFAULT TO BE LAST NON ""
COLUMN FOR YTIR
Else
YTIR = TeishutsuItemRow
End If
' FIRST ROW SOLUTION FOR L TOLERANCE.
If Sheets("提出用").Cells(TeishutsuItemRow, TeishutsuItemColumn +
4).Value = "" Then
' DO NOTHING, THIS MEANS WE WANT DEFAULT TO BE LAST NON ""
COLUMN FOR LTIR
Else
LTIR = TeishutsuItemRow
End If
Else
' THIS IS NOT A SOKUTEI POINT ROW, MOVE ALONG.
TeishutsuItemRow = TeishutsuItemRow + 1
TempLoop = TempLoop - 1
End If
Next TempLoop
' NOW LET'S SOLVE FOR THE TOLERANCE VALUES OF X AND Y WHICH ARE FAIRLY
STRAIGHTFORWARD
ToleranceStringX = Sheets("提出用").Cells(XTIR, TeishutsuItemColumn +
2).Value
ToleranceStringY = Sheets("提出用").Cells(YTIR, TeishutsuItemColumn +
3).Value
ToleranceValueX = LastNumber(ToleranceStringX)
ToleranceValueY = LastNumber(ToleranceStringY)
ToleranceValueX = Val(ToleranceValueX)
ToleranceValueY = Val(ToleranceValueY)
' INPUT IN THE CONDITIONAL FORMATTING FOR X AND Y TOLERANCES
Sheets("提出用").Cells(TeishutsuItemRow, TeishutsuItemColumn + 5)..Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreater, Formula1:=ToleranceValueX + 0.008
Selection.FormatConditions(1).Interior.ColorIndex = 48
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlLess, Formula1:=ToleranceValueX - 0.008
With Selection.FormatConditions(2).Font
.Bold = False
.Italic = True
End With
Selection.FormatConditions(2).Interior.ColorIndex = 48
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlBetween, Formula1:=ToleranceValueX - 0.008, _
Formula2:=ToleranceValueX + 0.008
Selection.FormatConditions(3).Interior.ColorIndex = xlNone
Sheets("提出用").Cells(TeishutsuItemRow, TeishutsuItemColumn + 6)..Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlGreater, Formula1:=ToleranceValueY + 0.008
Selection.FormatConditions(1).Interior.ColorIndex = 48
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlLess, Formula1:=ToleranceValueY - 0.008
With Selection.FormatConditions(2).Font
.Bold = False
.Italic = True
End With
Selection.FormatConditions(2).Interior.ColorIndex = 48
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlBetween, Formula1:=ToleranceValueY - 0.008, _
Formula2:=ToleranceValueY + 0.008
Selection.FormatConditions(3).Interior.ColorIndex = xlNone
' SOLVE FOR L WHICH WILL EITHER USE +- OR /.
If Sheets("提出用").Cells(TeishutsuItemRow, TeishutsuItemColumn +
4).Value = "" Then
' DO NOTHING, THIS MEANS WE WANT DEFAULT TO BE LAST NON "" COLUMN
FOR LTIR
Else
LTIR = TeishutsuItemRow
End If
ToleranceStringL = Sheets("提出用").Cells(LTIR, TeishutsuItemColumn +
4).Value
If InStr(ToleranceStringL, Separator1) Then
' THIS IS WITH /
' FIRST FIND THE BASE THEN REMOVE IT FROM THE STRING
LValueBase = FirstNumber(ToleranceStringL)
ToleranceStringL = Right$(ToleranceStringL, Len(ToleranceStringL)
- Len(LValueBase))
LValueBase = Val(LValueBase)
'ToleranceValuePML = Right(ToleranceValueX, Len(ToleranceValueX) -
InStrRev(ToleranceValueX, Separator2) - 1)
For Position = (InStr(ToleranceStringL, Separator1) + 1) To
Len(ToleranceStringL) Step 1
If InStr(NumericCharacters, Mid(ToleranceStringL, Position,
1)) Then
ToleranceValueML = ToleranceValueML &
Mid(ToleranceStringL, Position, 1)
' NOW A CHECK TO SEE IF ToleranceValueML HAS A MINUS SIGN
If InStr(ToleranceValueML, MinusSign) Then
ToleranceValueML = Right$(ToleranceValueML,
Len(ToleranceValueML) - 1)
End If
End If
Next Position
For Position = 1 To (InStr(ToleranceStringL, Separator1) - 1) Step
1
If InStr(NumericCharacters, Mid(ToleranceStringL, Position,
1)) Then
ToleranceValuePL = ToleranceValuePL &
Mid(ToleranceStringL, Position, 1)
End If
Next Position
' THIS IS TO ADD AND FIND HIGH/LOW FOR L TOLERANCE
ToleranceValueLHigh = Val(LValueBase) + Val(ToleranceValuePL)
ToleranceValueLLow = Val(LValueBase) - Val(ToleranceValueML)
' LASTLY SET TO VALUE TO USE IN CONDITIONAL FORMATTING
ToleranceValueLHigh = Val(ToleranceValueLHigh)
ToleranceValueLLow = Val(ToleranceValueLLow)
End If
If InStr(ToleranceStringL, Separator2) Then
' THIS IS WITH +-
LValueBase = FirstNumber(ToleranceStringL)
ToleranceValuePML = LastNumber(ToleranceStringL)
' THIS IS IN ORDER TO REMOVE THE +- SYMBOL
ToleranceValuePML = Right$(ToleranceValuePML,
Len(ToleranceValuePML) - 1)
' THIS IS TO ADD AND FIND HIGH/LOW FOR L TOLERANCE
ToleranceValueLHigh = Val(LValueBase) + Val(ToleranceValuePML)
ToleranceValueLLow = Val(LValueBase) - Val(ToleranceValuePML)
' LASTLY SET TO VALUE TO USE IN CONDITIONAL FORMATTING
ToleranceValueLHigh = Val(ToleranceValueLHigh)
ToleranceValueLLow = Val(ToleranceValueLLow)
End If
' NOW INPUT CONDITIONAL FORMATTING
Sheets("提出用").Cells(TeishutsuItemRow, TeishutsuItemColumn + 7)..Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater,
Formula1:=ToleranceValueLHigh
Selection.FormatConditions(1).Interior.ColorIndex = 48
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess,
Formula1:=ToleranceValueLLow
With Selection.FormatConditions(2).Font
.Bold = False
.Italic = True
End With
Selection.FormatConditions(2).Interior.ColorIndex = 48
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween,
Formula1:=ToleranceValueLLow, _
Formula2:=ToleranceValueLHigh
Selection.FormatConditions(3).Interior.ColorIndex = xlNone
' NEXT ROW INDICATOR, POINT NUMBER ADDITION
TeishutsuItemRow = TeishutsuItemRow + 1
SokuteiPointNumber = SokuteiPointNumber + 1
Loop
End Sub
Function LastNumber(ToleranceString) As String
Dim Newstring As String
Dim SpacePlace As Integer
Dim RevOut As String
Newstring = StrReverse(ToleranceString)
SpacePlace = InStr(1, Newstring, " ")
RevOut = Left(Newstring, SpacePlace - 1)
LastNumber = StrReverse(RevOut)
End Function
Function FirstNumber(ToleranceString) As String
Dim Newstring As String
Dim SpacePlace As Integer
Dim RevOut As String
Newstring = ToleranceString
SpacePlace = InStr(1, Newstring, " ")
RevOut = Left(Newstring, SpacePlace - 1)
FirstNumber = RevOut
End Function
|