RSMEANS Python REGEXP extractions
Attribute VB_Name = "RSUnits"
Option Explicit
''Constants for reference of unit types in RSMEANS
'' Floor, concrete, slab form, open web bar joist @ 2' OC,
on W beam and wall, 30'x30' bay, 29" deep, 65 PSF superimposed load, 110
PSF total load, for columns add
Public Const VBQT = """"
''these use named regexp returns based in python
''Public Const Regex_BAY+PYTHON =
"(?:(?P\d{1,})((?P\'|\" & VBQT &
"|ft|in))\W{0,}x\W{0,}(?P\d{1,})(?P\'|\"
& VBQT & "|ft|in)\W{0,}bay)"
Public Const Regex_BAY = "(?:([\d\.]{1,})((\'|\" & VBQT
& "|ft|in))\W{0,}x\W{0,}(\d{1,})(\'|\" &
VBQT & "|ft|in)\W{0,}bay)"
Public Const Regex_Addon = "(?:for\W{0,}(?P\b.+\b)\W{0,}add)\W{0,}"
''Public Const Regex_SPACE+python =
"(?:.+,(?P.+?)(\@\W{0,}(?P\d{1,})((?P\'|\"
& VBQT & "|ft|in)\W{0,}oc)))"
Public Const Regex_SPACE = "(?:.+,(.+?)(\@\W{0,}([\d\.]{1,})((\'|\" &
VBQT & "|ft|in)\W{0,}oc)))"
Public Const Regex_SPAN = "(?:.+,(.+?)(\@\W{0,}([\d\.]{1,})((\'|\" &
VBQT & "|ft|in)\W{0,}span)))"
''Public Const Regex_DEEP+PYTHON =
"(?:(?P\d{1,})(?P\'|\" & VBQT &
"|ft|in)\W{0,}deep)"
Public Const Regex_DEEP = "(?:([\d\.]{1,})(\'|\" &
VBQT & "|ft|in)\W{0,}deep)"
Public Const Regex_LOAD = "(?:(?P\d{1,})\W{0,}(?P(P[S|L]F))\W{0,}(?P\w{1,12})\W{0,}load)"
'' full regexp with names regexp = watch for VBQTs!
''
(?:(?P\d{1,})((?P\'|\"|ft|in))\W{0,}x\W{0,}(?P\d{1,})(?P\'|\"|ft|in)\W{0,}bay)|(?:for\W{0,}(?P\b.+\b)\W{0,}add)\W{0,}|(?:.+,(?P.+?)(\@\W{0,}(?P\d{1,})((?P\'|\"|ft|in)\W{0,}oc)))|(?:(?P\d{1,})(?P\'|\"|ft|in)\W{0,}deep)|(?:(?P\d{1,})\W{0,}(?P(P[S|L]F))\W{0,}(?P\w{1,12})\W{0,}load)
Type Units
BAY_X As Integer
BAY_Y As Integer
BAY_X_UNIT As String
BAY_Y_UNIT As String
End Type
Function RSM_Val(strValue As String, Optional strType As String) As Variant
Dim rangeCaller As Range
Dim reg As New Regexp
Dim strl As String
Dim ret As MatchCollection
Dim strNumberFormat As String
''only returns one value at a time so only need to track
one measurement except wxd for 'bay'
Dim Height As Single
Dim Width As Single
Dim Depth As Single
Dim UNIT As String
Dim Found As Boolean ''for control
over formatting
Found = False
strl =
LCase(strValue)
strType =
LCase(strType)
Set rangeCaller =
Application.Caller
Select Case strType
Case "bay"
reg.Pattern = RSUnits.Regex_BAY
Set ret =
reg.Execute(strValue)
If ret.Count >
0 Then
Width = ret.Item(0).SubMatches.Item(0)
If ret.Item(0).SubMatches.Item(1) = VBQT Then ret.Item(0).SubMatches.Item(1) = "''" ''may not be needed returning text.
Depth = ret.Item(0).SubMatches.Item(3)
If ret.Item(0).SubMatches.Item(4) = VBQT Then ret.Item(0).SubMatches.Item(4) = "''" ''may not be needed returning text.
RSM_Val = Width & ret.Item(0).SubMatches.Item(1) & " x " &
Depth & ret.Item(0).SubMatches.Item(4)
UNIT
= "General"
rangeCaller.Cells(1, 1).HorizontalAlignment
= xlCenter
rangeCaller.Cells(1, 1).VerticalAlignment
= xlCenter
Found = True
End If
Case "bayx"
reg.Pattern = RSUnits.Regex_BAY
Set ret =
reg.Execute(strValue)
If ret.Count >
0 Then
Width = ret.Item(0).SubMatches.Item(0)
UNIT
= ret.Item(0).SubMatches.Item(1)
Depth = ret.Item(0).SubMatches.Item(3)
strNumberFormat = "00" &
VBQT & UNIT & VBQT
RSM_Val = Width
rangeCaller.Cells(1, 1).HorizontalAlignment
= xlRight
Found = True
End If
Case "bayy"
reg.Pattern = RSUnits.Regex_BAY
Set ret =
reg.Execute(strValue)
If ret.Count >
0 Then
Depth = ret.Item(0).SubMatches.Item(3)
UNIT
= ret.Item(0).SubMatches.Item(4)
RSM_Val = Depth
rangeCaller.Cells(1, 1).HorizontalAlignment
= xlRight
Found = True
End If
Case "deep"
reg.Pattern = RSUnits.Regex_DEEP
Set ret =
reg.Execute(strValue)
If ret.Count >
0 Then
Height = ret.Item(0).SubMatches.Item(0)
UNIT
= ret.Item(0).SubMatches.Item(1)
RSM_Val = Height
Found = True
End If
End Select
If Found = True Then
'''Reset formatting
FormatCell
Application.Caller, UNIT
Else
''''reset cell to general formatting
RSM_Val =
""
rangeCaller.NumberFormat
= "General"
rangeCaller.HorizontalAlignment = xlTop
rangeCaller.VerticalAlignment = xlLeft
End If
End Function
Private Sub FormatCell(xr As Range,
UNIT As String)
Select Case UNIT
Case VBQT, "''" ''inches
UNIT =
"00.00" & "''"
Case "'"
UNIT =
"00" & "'"
Case Else
UNIT =
"General"
End Select
Sheet1.strNumberFormat = UNIT
''trick to attempt force override on sheet value change
xr.NumberFormat =
UNIT
End Sub
Comments
Post a Comment