phuynh Posted February 21, 2022 Posted February 21, 2022 Hello everyone, Just a collection of functions that I learn and post here, hope they are usefull to you just as I do in my day to day job. Phh ''################################################################# ''## Functions to deal with feet-inches format ## ''## in a form of [#'-#"] or [#'-# #/##"] or [#'-#.##"] ## ''## By Phh, 2010, last update 2021 ## ''################################################################# ''## todec() Convert to decimal ## ''## toimpe() Convert to imperial, engineering format ## ''## with optional precision argument, default 1/16" ## ''## toimpa() Convert to imperial, architectural format ## ''## with optional precision argument, default 1/16" ## ''## sumtodec() Similar to SUM function, decimal format ## ''## sumtoimpe() Similar to SUM function, engineering format ## ''## sumtoimpa() Similar to SUM function, architectural format ## ''## frac2num() Sub function, convert fraction to decimal ## ''################################################################# Option Explicit Public Function todec(strX As String, Optional argDivBy As Double) As Double Dim startPos As Integer, ftPos As Integer, frPos As Integer Dim rdLen, argDivNum As Double If argDivBy > 0 Then argDivNum = argDivBy Else argDivNum = 1 End If strX = Replace(Replace(strX, """", ""), "-", "") strX = WorksheetFunction.Trim(strX) startPos = 1 ftPos = InStr(startPos, strX, "'") frPos = InStr(startPos, strX, "/") If ftPos = 0 And frPos = 0 Then todec = (Val(strX) / argDivNum) Exit Function End If If ftPos = 0 And frPos > 0 Then todec = (frac2num(strX) / argDivNum) Exit Function End If rdLen = CDbl(Left(strX, ftPos - 1)) * 12 If frPos = 0 Then rdLen = rdLen + (Abs(Val(Mid(strX, ftPos + 1, Len(strX))))) todec = (rdLen / argDivNum) Exit Function End If rdLen = rdLen + frac2num(Mid(strX, ftPos + 1, Len(strX))) todec = (rdLen / argDivNum) End Function Public Function sumtodec(ParamArray Xrange() As Variant) As Double Dim sumArray As Double Dim theVal As Variant Dim I As Integer For I = LBound(Xrange) To UBound(Xrange) If TypeOf Xrange(I) Is Range Then For Each theVal In Xrange(I) sumArray = sumArray + todec(CStr(theVal)) Next theVal Else sumArray = sumArray + CDbl(Xrange(I)) End If Next sumtodec = sumArray End Function Public Function toimpe(aLen As Double, Optional argRd As Variant = 16) As String Dim rdLen As Double, argRdNum As Double If argRd >= 1 Then argRdNum = 1 / Fix(argRd) ElseIf argRd < 1 And argRd > 0 Then argRdNum = argRd ElseIf argRd = 0 Then toimpe = (Fix(aLen / 12)) & "'-" & (aLen - (12 * Fix(aLen / 12))) & """" Exit Function End If rdLen = excel.WorksheetFunction.Round(aLen / argRdNum, 0) * argRdNum toimpe = (Fix(rdLen / 12)) & "'-" & (rdLen - (12 * Fix(rdLen / 12))) & """" End Function Public Function toimpa(aLen As Double, Optional argRd As Variant = 16) As String Dim rdLen As Double, argRdNum As Double If argRd >= 1 Then argRdNum = 1 / Fix(argRd) ElseIf argRd < 1 And argRd > 0 Then argRdNum = argRd ElseIf argRd = 0 Then toimpa = (Fix(aLen / 12)) & "'-" & excel.WorksheetFunction.Text((aLen - (12 * Fix(aLen / 12))), "0 ##/####") & """" Exit Function End If rdLen = excel.WorksheetFunction.Round(aLen / argRdNum, 0) * argRdNum toimpa = (Fix(rdLen / 12)) & "'-" & excel.WorksheetFunction.Text((rdLen - (12 * Fix(rdLen / 12))), "0 ##/####") & """" End Function Public Function sumtoimpe(ParamArray Xrange() As Variant) As String Dim sumArray As Double, argRdNum As Double Dim theVal As Variant Dim I As Integer For I = LBound(Xrange) To UBound(Xrange) If TypeOf Xrange(I) Is Range Then For Each theVal In Xrange(I) sumArray = sumArray + todec(CStr(theVal)) Next theVal Else sumArray = sumArray + CDbl(Xrange(I)) End If Next 'Set precision round of to 1/256" as default, change if required! argRdNum = (1 / 256) sumArray = excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum sumtoimpe = (Fix(sumArray / 12)) & "'-" & (sumArray - (12 * Fix(sumArray / 12))) & """" End Function Public Function sumtoimpa(ParamArray Xrange() As Variant) As String Dim sumArray As Double, argRdNum As Double Dim theVal As Variant Dim I As Integer For I = LBound(Xrange) To UBound(Xrange) If TypeOf Xrange(I) Is Range Then For Each theVal In Xrange(I) sumArray = sumArray + todec(CStr(theVal)) Next theVal Else sumArray = sumArray + CDbl(Xrange(I)) End If Next 'Set precision round of to 1/256" as default, change if required! argRdNum = (1 / 256) sumArray = excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum sumtoimpa = (Fix(sumArray / 12)) & "'-" & excel.WorksheetFunction.Text((sumArray - (12 * Fix(sumArray / 12))), "0 ##/####") & """" End Function Function frac2num(ByVal X As String) As Double Dim P As Integer Dim N As Double, Num As Double, Den As Double X = Trim$(X) P = InStr(X, "/") If P = 0 Then N = Val(X) Else Den = Val(Mid$(X, P + 1)) If Den = 0 Then Error 11 X = Trim$(Left$(X, P - 1)) P = InStr(X, " ") If P = 0 Then Num = Val(X) Else Num = Val(Mid$(X, P + 1)) N = Val(Left$(X, P - 1)) End If End If If Den <> 0 Then N = N + Num / Den End If frac2num = N End Function 1 Quote
phuynh Posted August 27, 2022 Author Posted August 27, 2022 (edited) Update functions to work with negative feet-inches Remove optional "argument_format" Phh ''################################################################# ''## 7 Functions to deal with feet-inches format in Excel ## ''## in form of [#'-#"] or [#'-# #/##"] or [#'-#.##"] ## ''## By Phh, 2010, last update 6/26/2022 ## ''## Functions update to work with negative feet-inches ## ''################################################################# ''## todec() Convert to decimal ## ''## toimpe() Convert to imperial, engineering format ## ''## with optional precision argument, default 1/16" ## ''## toimpa() Convert to imperial, architectural format ## ''## with optional precision argument, default 1/16" ## ''## sumtodec() Similar to SUM function, decimal format ## ''## sumtoimpe() Similar to SUM function, engineering format ## ''## sumtoimpa() Similar to SUM function, architectural format ## ''## frac2num() Sub function, convert fraction to decimal ## ''################################################################# Option Explicit Public Function todec(strX As String) As Double Dim startPos, ftPos, frPos, signofNum As Integer Dim rdLen As Double strX = Trim$(strX) If Left$(strX, 1) = "-" Then signofNum = -1 Else signofNum = 1 End If strX = Replace(Replace(strX, """", ""), "-", "") startPos = 1 ftPos = InStr(startPos, strX, "'") frPos = InStr(startPos, strX, "/") If ftPos = 0 And frPos = 0 Then todec = Val(strX) * signofNum Exit Function End If If ftPos = 0 And frPos > 0 Then todec = frac2num(strX) * signofNum Exit Function End If rdLen = CDbl(Left$(strX, ftPos - 1)) * 12 If frPos = 0 Then rdLen = rdLen + (Val(Mid$(strX, ftPos + 1, Len(strX)))) todec = rdLen * signofNum Exit Function End If rdLen = rdLen + frac2num(Mid$(strX, ftPos + 1, Len(strX))) todec = rdLen * signofNum End Function Public Function toimpe(rawLen As Double, Optional argRd As Variant = 16) As String Dim rdLen As Double, argRdNum As Double If argRd >= 1 Then argRdNum = 1 / Fix(argRd) rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum ElseIf argRd < 1 And argRd > 0 Then argRdNum = argRd rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum Else rdLen = rawLen End If If Abs(Excel.WorksheetFunction.Round(rawLen / argRdNum, 0)) < Abs(argRdNum) Then toimpe = "0""" Exit Function End If If rdLen <= -12 Or rdLen >= 12 Then toimpe = (Fix(rdLen / 12)) & "'-" & Abs(rdLen - (12 * Fix(rdLen / 12))) & """" ElseIf rdLen < 12 And rdLen > -12 Then toimpe = rdLen & """" End If End Function Public Function toimpa(rawLen As Double, Optional argRd As Variant = 16) As String Dim rdLen As Double, argRdNum As Double If argRd >= 1 Then argRdNum = 1 / Fix(argRd) rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum ElseIf argRd < 1 And argRd > 0 Then argRdNum = argRd rdLen = Excel.WorksheetFunction.Round(rawLen / argRdNum, 0) * argRdNum Else rdLen = rawLen End If If Abs(Excel.WorksheetFunction.Round(rawLen / argRdNum, 0)) < Abs(argRdNum) Then toimpa = "0""" Exit Function End If If rdLen <= -12 Or rdLen >= 12 Then toimpa = (Fix(rdLen / 12)) & "'-" & Excel.WorksheetFunction.Text(Abs(rdLen - (12 * Fix(rdLen / 12))), "0 ##/####") & """" ElseIf rdLen < 12 And rdLen > -12 Then If (rdLen - Fix(rdLen)) = 0 Then toimpa = rdLen & """" Else toimpa = Excel.WorksheetFunction.Text(rdLen, "# ###/###") & """" End If End If End Function Public Function sumtodec(ParamArray Xrange() As Variant) As Double Dim sumArray As Double Dim theVal As Variant Dim I As Integer For I = LBound(Xrange) To UBound(Xrange) If TypeOf Xrange(I) Is Range Then For Each theVal In Xrange(I) sumArray = sumArray + todec(CStr(theVal)) Next theVal Else sumArray = sumArray + CDbl(Xrange(I)) End If Next sumtodec = sumArray End Function Public Function sumtoimpe(ParamArray Xrange() As Variant) As String Dim sumArray As Double, argRdNum As Double Dim theVal As Variant Dim I As Integer For I = LBound(Xrange) To UBound(Xrange) If TypeOf Xrange(I) Is Range Then For Each theVal In Xrange(I) sumArray = sumArray + todec(CStr(theVal)) Next theVal Else sumArray = sumArray + CDbl(Xrange(I)) End If Next ''####################################################################### ''## Set precision round-off to 1/512" as default, change if required! ## ''####################################################################### argRdNum = (1 / 512) sumArray = Excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum If sumArray <= -12 Or sumArray >= 12 Then sumtoimpe = (Fix(sumArray / 12)) & "'-" & Abs(sumArray - (12 * Fix(sumArray / 12))) & """" ElseIf sumArray < 12 And sumArray > -12 Then sumtoimpe = sumArray & """" End If End Function Public Function sumtoimpa(ParamArray Xrange() As Variant) As String Dim sumArray As Double, argRdNum As Double Dim theVal As Variant Dim I As Integer For I = LBound(Xrange) To UBound(Xrange) If TypeOf Xrange(I) Is Range Then For Each theVal In Xrange(I) sumArray = sumArray + todec(CStr(theVal)) Next theVal Else sumArray = sumArray + CDbl(Xrange(I)) End If Next ''####################################################################### ''## Set precision round-off to 1/512" as default, change if required! ## ''####################################################################### argRdNum = (1 / 512) sumArray = Excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum If sumArray <= -12 Or sumArray >= 12 Then sumtoimpa = (Fix(sumArray / 12)) & "'-" & Excel.WorksheetFunction.Text(Abs(sumArray - (12 * Fix(sumArray / 12))), "0 ##/####") & """" ElseIf sumArray < 12 And sumArray > -12 Then If (sumArray - Fix(sumArray)) = 0 Then sumtoimpa = sumArray & """" Else sumtoimpa = Excel.WorksheetFunction.Text(sumArray, "# ###/###") & """" End If End If End Function Function frac2num(ByVal X As String) As Double Dim P As Integer Dim N As Double, Num As Double, Den As Double X = (X) P = InStr(X, "/") If P = 0 Then N = Val(X) Else Den = Val(Mid$(X, P + 1)) If Den = 0 Then Error 11 X = Trim$(Left$(X, P - 1)) P = InStr(X, " ") If P = 0 Then Num = Val(X) Else Num = Val(Mid$(X, P + 1)) N = Val(Left$(X, P - 1)) End If End If If Den <> 0 Then N = N + Num / Den End If frac2num = N End Function Edited September 4, 2022 by phuynh Replace "Excel.WorkSheetFunction.Trim()" with "Trim$()", .Mid() with Mid$, .Left() with Left$() Quote
phuynh Posted September 20, 2022 Author Posted September 20, 2022 (edited) Just plain Excel formula for quick convert from decimal to Imperial feet-inches, when I do BOM, schedule for my drawings, or share workbook to ppl don't use VBA (like my boss and my co-worker, Mac users) Update formula to resolve rounding & text formatting issue (11/5/2022), see post below From decimal (inches) to Imperial architectural format round-off 1/64 =IF(NOT(ISNUMBER(A1)),"n/a", IF(OR(MROUND(A1,SIGN(A1)*1/64)>=12,MROUND(A1,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1,SIGN(A1)*1/64)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(A1),1/64),12),"0 #/##")&"""", TEXT(MROUND(A1,SIGN(A1)*1/64),"# #/##")&"""")) From decimal (inches) to Imperial engineering format round-off 1/64 =IF(NOT(ISNUMBER(A1)),"n/a", IF(OR(MROUND(A1,SIGN(A1)*1/64)>=12,MROUND(A1,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1,SIGN(A1)*1/64)/12,0)&"'-"&MOD(MROUND(ABS(A1),1/64),12)&"""", MROUND(A1,SIGN(A1)*1/64)&"""")) From decimal (feet) to Imperial architectural format round-off 1/64 =IF(NOT(ISNUMBER(A1)),"n/a", IF(OR(MROUND(A1*12,SIGN(A1)*1/64)>=12,MROUND(A1*12,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1*12,SIGN(A1)*1/64)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(A1*12),1/64),12),"0 #/##")&"""", TEXT(MROUND(A1*12,SIGN(A1)*1/64),"# #/##")&"""")) From decimal (feet) to Imperial engineering format round-off 1/64 =IF(NOT(ISNUMBER(A1)),"n/a", IF(OR(MROUND(A1*12,SIGN(A1)*1/64)>=12,MROUND(A1*12,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1*12,SIGN(A1)*1/64)/12,0)&"'-"&MOD(MROUND(ABS(A1*12),1/64),12)&"""", MROUND(A1*12,SIGN(A1)*1/64)&"""")) Phh Edited November 23, 2022 by phuynh Update formula 2nd line(s) to resolve rounding and text formatting issue, Ex: 119.999 when convert round-off should display 10'-0" instead of 9'-12" (my apology!) Quote
phuynh Posted October 31, 2022 Author Posted October 31, 2022 (edited) Update formula (all) 2nd lines (see post above) to resolve rounding and text formatting issue, For example: 119.999 when convert and round-off should display 10'-0" instead of 9'-12" Update MROUND() using with SIGN() to correct issue with negative number My apology! Phh Edited October 31, 2022 by phuynh 1 Quote
Danielm103 Posted November 4, 2022 Posted November 4, 2022 Good stuff! I the approach when importing from excel to cad using C++. 1, read the number raw value from excel. 2, read the number format ID; 3, read the format, example #,##0.00, #.##0.00 or "\'" etc. 4, translate using cad functions, LUPREC, LUNITS, acutCvUnit etc. For tables, I use AcValue and a format string %lu2%pr2 if I see #,##0.00 There’s a thing for the thousand’s separator, %th I think Not sure if that stuff in VBA Quote
phuynh Posted November 4, 2022 Author Posted November 4, 2022 (edited) There is something I am still learning, some minor issue with rounding when combine with text formatting, and fact that I work it out but still test and debugging! Let try this sequence with round-off 1/64 for example: From decimal (inches) to Imperial architectural format round-off 1/64 Cell A1 11.9 = 11 29/32" [Correct] 11.99 = 11 63/64" [Correct] 11.999 = 12" [Correct but some what!] I expect the format would display 1'-0" but end up 12" ?!?! what I learn is that on the 1st line of the formula, the second IF() statement the value of A1 not the same value of A1 on 2nd and 3rd lines because of MROUND()! To correct this issue, the value of A1 should be exact the same throughout! Here the update version I am currently testing... but not final, please bear with me for my hiccup! =IF(OR(MROUND(A1,SIGN(A1)*1/64)>=12,MROUND(A1,SIGN(A1)*1/64)<=-12), ROUNDDOWN(MROUND(A1,SIGN(A1)*1/64)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(A1),1/64),12),"0 #/##")&"""", TEXT(MROUND(A1,SIGN(A1)*1/64),"# #/##")&"""") Please note that I sacrifice first IF() because it is too long, move SIGN() inside MROUND() and remove ABS(), shorten format numerator (the denominator number digits are importance and must match with number of digits of rounding, ex. 1/2, 1/8 -> #/# ; 1/16, 1/32, 1/64 -> #/## ; 1/4096 -> #/####, etc.) Will keep you post, and sorry for my bad! 11/5/2022 Update formula to resolve rounding & text formatting issue (see post above) Rearrange MROUND() and SIGN() for consistent and easy to read Phh Edited November 6, 2022 by phuynh Quote
phuynh Posted November 21, 2022 Author Posted November 21, 2022 (edited) Excel LAMBDA Function In Excel, Office 365 or recent version of Excel if LAMBDA function available, you can take advance of looooong calculation formula by using LAMBDA function! Per MS: Quote Use a LAMBDA function to create custom, reusable functions and call them by a friendly name. The new function is available throughout the workbook and called like native Excel functions. You can create a function for a commonly used formula, eliminate the need to copy and paste this formula (which can be error-prone), and effectively add your own functions to the native Excel function library. Furthermore, a LAMBDA function doesn’t require VBA, macros or JavaScript, so non-programmers can also benefit from its use. Syntax =LAMBDA([parameter1, parameter2, …,] calculation) Define Name: give_a_meaningful_name Clear "Refer to" box: And paste your calculation formula to create custom user define function. In this case, for example: I create name "str2impa" and replace "A1" to "in" which is the parameter. =LAMBDA(in, IF(NOT(ISNUMBER(in)),"n/a", IF(OR(MROUND(in,SIGN(in)*1/64)>=12,MROUND(in,SIGN(in)*1/64)<=-12), ROUNDDOWN(MROUND(in,SIGN(in)*1/64)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(in),1/64),12),"0 #/##")&"""", TEXT(MROUND(in,SIGN(in)*1/64),"# #/##")&"""")) ) Phh Edited November 24, 2022 by phuynh Quote
phuynh Posted October 1, 2023 Author Posted October 1, 2023 (edited) Tweak version of lambda function from previous post with added flexibility of conversion and simple range calculations if you know your conversion factor and round-off number of your choice. Lambda function for convert decimal value to imperial feet-inches fraction, text format [#'-# #/#"] Name: testfunc (or some meaningful name) usage: testfunc(varNum, cFact, rdOff) Parameters notes: varNum = Required, decimal number value to be converted (ex: value in a cell A1, B10, C15, etc.. or range A:A, or multiple ranges (A:A,B:B) - note of enclosed parenthesis and ranges separated by comma) cFact = Required, conversion factor from value (1 = inch, 1/12 = feet, 1/36 = yard, 25.4 = millimeter, 2.54 = centimeter, 0.0254 = meter, etc...) Or define Excel Name to hold conversion factor value, ex: in=1 ft=1/12 yd=1/36 mm=25.4 cm=2.54 m=0.0254 ... ... ... rdOff = Required, rounded to the desired multiple (ex: 1, 1/2, 1/4, 1/8, 1/16, 1/64, 1/4096, etc...) =LAMBDA(varNum, cFact, rdOff, IF(NOT(ISNUMBER(SUM(varNum))),"n/a", IF(OR(MROUND(SUM(varNum)/cFact,SIGN(SUM(varNum))*rdOff)>=12,MROUND(SUM(varNum)/cFact,SIGN(SUM(varNum))*rdOff)<=-12), ROUNDDOWN(MROUND(SUM(varNum)/cFact,SIGN(SUM(varNum))*rdOff)/12,0)&"'-"&TEXT(MOD(MROUND(ABS(SUM(varNum)/cFact),rdOff),12),"0 #/####")&"""", TEXT(MROUND(SUM(varNum)/cFact,SIGN(SUM(varNum))*rdOff),"# #/####")&"""")) ) Phh Edited April 9 by phuynh Quote
LKW Posted January 2 Posted January 2 phuynh, I'm totally lost. I have 2 ranges of cells (M6:M2307) & (O6:O2307) where the values are entered as decimal feet & inches. Ex. 10'-10" is entered in cell as 10.8333. Would you be so kind as to show me how to get your LAMBDA function to work? Pretty new to this this type of advanced formula so please be patient with my ignorance. Thanks, LKW Quote
phuynh Posted January 3 Author Posted January 3 (edited) Hi LKM, If having multi-range, enclosed with parenthesis and ranges separated by comma to become 1 element represent varNum, the function should work. ex. testfunc((M6:M2307,O6:O2307),1,1/64) Phh Edited April 9 by phuynh Quote
phuynh Posted May 29 Author Posted May 29 (edited) LAMBDA function for convert Imperial feet-inches (in various formats) to decimal value, with optional argument conversion factor [cFact]. or define "Excel Name" to hold conversion factor such as: in=1 (default inch if not specify) ft=1/12 yd=1/36 mi=1/63360 (mile) mm=25.4 cm=2.54 m=0.0254 ... ... ... =LAMBDA(imperial,[cFact], LET(si,IF(LEFT(imperial,1)="-",-1,1), ft,IFERROR(ABS(VALUE(LEFT(imperial,(FIND("'",imperial)-1)))),0), in,TRIM(SUBSTITUTE(SUBSTITUTE(IFERROR(RIGHT(imperial,LEN(imperial)-FIND("'",imperial)),imperial),"-",""),"""","")), si*(ft*12+VALUE(IF(ISERR(AND(FIND(" ",in),FIND("/",in))),IFERROR(VALUE("0 "&in),in),in)))/IF(ISOMITTED(cFact),1,1/cFact)) ) Some test Phh Edited September 24 by phuynh Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.