Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
parsing number ranges
I need to parse cells in a spreadsheet, that contain strings such as "4-6" or "12-37" or "40-46", that represent ranges of numbers, in order to find numbers contained in those ranges. For example, the desired output for "4-6" would be "4,5,6". Find and replace is not a suitable tool because I can't predict what strings will be found. -- chchch ------------------------------------------------------------------------ chchch's Profile: http://www.excelforum.com/member.php...o&userid=31970 View this thread: http://www.excelforum.com/showthread...hreadid=517783 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
parsing number ranges
Are these strings delimited in any way?
This macro doesn't assume that they are (other than by some non-numeric character): Public Sub ReplaceRangeWithList() Const sDELIM As String = "," Const sRANGESEP As String = "-" Dim rCell As Range Dim nLeft As Long Dim nRight As Long Dim nSmall As Long Dim nLarge As Long Dim nPos As Long Dim nStep As Long Dim i As Long Dim sTemp As String Dim sTemp2 As String If Not TypeOf Selection Is Range Then Exit Sub For Each rCell In Selection With rCell If .Text Like "*#" & sRANGESEP & "#*" Then sTemp = .Text nPos = InStr(2, sTemp, sRANGESEP) Do While nPos If IsNumeric(Mid(sTemp, nPos - 1, 1)) And _ IsNumeric(Mid(sTemp, nPos + 1, 1)) Then nLeft = nPos - 1 Do While nLeft 1 If Not IsNumeric(Mid(sTemp, nLeft - 1, _ 1)) Then Exit Do nLeft = nLeft - 1 Loop nSmall = CLng(Mid(sTemp, nLeft, nPos - nLeft)) nRight = nPos + 1 Do While nRight < Len(sTemp) If Not IsNumeric(Mid(sTemp, nRight + 1, 1)) _ Then Exit Do nRight = nRight + 1 Loop nLarge = CLng(Mid(sTemp, nPos + 1, nRight - nPos)) nStep = Sgn(nLarge - nSmall) sTemp2 = sDELIM & CStr(nSmall) If nStep Then For i = nSmall + nStep To nLarge Step nStep sTemp2 = sTemp2 & sDELIM & i Next i End If sTemp = Left(sTemp, nLeft - 1) & _ Mid(sTemp2, Len(sDELIM) + 1) & _ Mid(sTemp, nRight + 1) End If nPos = InStr(nPos + 1, sTemp, sRANGESEP) Loop On Error Resume Next Application.EnableEvents = False .Value = sTemp Application.EnableEvents = True On Error GoTo 0 End If End With Next rCell End Sub Note that this will only work with whole numbers. In article , chchch wrote: I need to parse cells in a spreadsheet, that contain strings such as "4-6" or "12-37" or "40-46", that represent ranges of numbers, in order to find numbers contained in those ranges. For example, the desired output for "4-6" would be "4,5,6". Find and replace is not a suitable tool because I can't predict what strings will be found. |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
parsing number ranges
THAT is 'way beyond COOL, JE..........you done good!
It even works with 1-5, 8-12, 21-19 all in the same cell, returning 1,2,3,4,5,8,9,10,11,12,21,20,19 I don't know when I'll ever use it, but it's going directly into my goodie-stash. Vaya con Dios, Chuck, CABGx3 "JE McGimpsey" wrote: Are these strings delimited in any way? This macro doesn't assume that they are (other than by some non-numeric character): Public Sub ReplaceRangeWithList() Const sDELIM As String = "," Const sRANGESEP As String = "-" Dim rCell As Range Dim nLeft As Long Dim nRight As Long Dim nSmall As Long Dim nLarge As Long Dim nPos As Long Dim nStep As Long Dim i As Long Dim sTemp As String Dim sTemp2 As String If Not TypeOf Selection Is Range Then Exit Sub For Each rCell In Selection With rCell If .Text Like "*#" & sRANGESEP & "#*" Then sTemp = .Text nPos = InStr(2, sTemp, sRANGESEP) Do While nPos If IsNumeric(Mid(sTemp, nPos - 1, 1)) And _ IsNumeric(Mid(sTemp, nPos + 1, 1)) Then nLeft = nPos - 1 Do While nLeft 1 If Not IsNumeric(Mid(sTemp, nLeft - 1, _ 1)) Then Exit Do nLeft = nLeft - 1 Loop nSmall = CLng(Mid(sTemp, nLeft, nPos - nLeft)) nRight = nPos + 1 Do While nRight < Len(sTemp) If Not IsNumeric(Mid(sTemp, nRight + 1, 1)) _ Then Exit Do nRight = nRight + 1 Loop nLarge = CLng(Mid(sTemp, nPos + 1, nRight - nPos)) nStep = Sgn(nLarge - nSmall) sTemp2 = sDELIM & CStr(nSmall) If nStep Then For i = nSmall + nStep To nLarge Step nStep sTemp2 = sTemp2 & sDELIM & i Next i End If sTemp = Left(sTemp, nLeft - 1) & _ Mid(sTemp2, Len(sDELIM) + 1) & _ Mid(sTemp, nRight + 1) End If nPos = InStr(nPos + 1, sTemp, sRANGESEP) Loop On Error Resume Next Application.EnableEvents = False .Value = sTemp Application.EnableEvents = True On Error GoTo 0 End If End With Next rCell End Sub Note that this will only work with whole numbers. In article , chchch wrote: I need to parse cells in a spreadsheet, that contain strings such as "4-6" or "12-37" or "40-46", that represent ranges of numbers, in order to find numbers contained in those ranges. For example, the desired output for "4-6" would be "4,5,6". Find and replace is not a suitable tool because I can't predict what strings will be found. |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
parsing number ranges
Many thanks, JE McGimpsey, that did the trick. You saved me a huge amount of time! Regards, Ciaran -- chchch ------------------------------------------------------------------------ chchch's Profile: http://www.excelforum.com/member.php...o&userid=31970 View this thread: http://www.excelforum.com/showthread...hreadid=517783 |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
parsing number ranges
This version, done as a function, is a bit more robust - it allows a
change in the range separator. For instance, NumberRangeToList("1-5,8-12,21-19","-") will return the same result as your example: Public Function NumberRangeToList( _ ByVal sInput As String, _ Optional sRangeSeparator As String = "-", _ Optional sDelimiter As String = ",") As Variant Const nMAXCHARS As Long = 32767 Dim nLeftStartChar As Long Dim nRightEndChar As Long Dim nLeftArg As Long Dim nRightArg As Long Dim nPos As Long Dim nStep As Long Dim nSepCharCount As Long Dim i As Long Dim sTemp As String Dim sTemp2 As String Dim bGoodString As Boolean sTemp = sInput bGoodString = True nSepCharCount = Len(sRangeSeparator) If Len(sInput) 0 And nSepCharCount 0 Then If sTemp Like "*#" & sRangeSeparator & "#*" Then nPos = InStr(2, sTemp, sRangeSeparator) Do While nPos nLeftStartChar = nPos - 1 nRightEndChar = nPos + nSepCharCount If IsNumeric(Mid(sTemp, nLeftStartChar, 1)) And _ IsNumeric(Mid(sTemp, nRightEndChar, 1)) Then Do While nLeftStartChar 1 If Not IsNumeric(Mid(sTemp, _ nLeftStartChar - 1, 1)) Then Exit Do nLeftStartChar = nLeftStartChar - 1 Loop nLeftArg = CLng(Mid(sTemp, nLeftStartChar, _ nPos - nLeftStartChar)) Do While nRightEndChar < Len(sTemp) If Not IsNumeric(Mid(sTemp, _ nRightEndChar + 1, 1)) Then Exit Do nRightEndChar = nRightEndChar + 1 Loop nRightArg = CLng(Mid(sTemp, _ nPos + nSepCharCount, _ nRightEndChar - (nPos + nSepCharCount - 1))) sTemp2 = sDelimiter & CStr(nLeftArg) nStep = Sgn(nRightArg - nLeftArg) If nStep Then For i = nLeftArg + nStep To _ nRightArg Step nStep sTemp2 = sTemp2 & sDelimiter & i bGoodString = Len(sTemp2) <= nMAXCHARS If Not bGoodString Then Exit Do Next i Else nPos = nPos - nSepCharCount End If sTemp = Left(sTemp, nLeftStartChar - 1) & _ Mid(sTemp2, Len(sDelimiter) + 1) & _ Mid(sTemp, nRightEndChar + 1) bGoodString = Len(sTemp) <= nMAXCHARS If Not bGoodString Then Exit Do End If nPos = InStr(nPos + nSepCharCount, sTemp, _ sRangeSeparator) Loop End If End If If bGoodString Then NumberRangeToList = sTemp Else NumberRangeToList = CVErr(xlErrValue) End If End Function In article , CLR wrote: It even works with 1-5, 8-12, 21-19 all in the same cell, returning 1,2,3,4,5,8,9,10,11,12,21,20,19 I don't know when I'll ever use it, but it's going directly into my goodie-stash. |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
parsing number ranges
WOW, you just "dissappeared into the cornfield" with that one........<g
I understood how to use the first one, but have no clue here........ Vaya con Dios, Chuck, CABGx3 "JE McGimpsey" wrote: This version, done as a function, is a bit more robust - it allows a change in the range separator. For instance, NumberRangeToList("1-5,8-12,21-19","-") will return the same result as your example: Public Function NumberRangeToList( _ ByVal sInput As String, _ Optional sRangeSeparator As String = "-", _ Optional sDelimiter As String = ",") As Variant Const nMAXCHARS As Long = 32767 Dim nLeftStartChar As Long Dim nRightEndChar As Long Dim nLeftArg As Long Dim nRightArg As Long Dim nPos As Long Dim nStep As Long Dim nSepCharCount As Long Dim i As Long Dim sTemp As String Dim sTemp2 As String Dim bGoodString As Boolean sTemp = sInput bGoodString = True nSepCharCount = Len(sRangeSeparator) If Len(sInput) 0 And nSepCharCount 0 Then If sTemp Like "*#" & sRangeSeparator & "#*" Then nPos = InStr(2, sTemp, sRangeSeparator) Do While nPos nLeftStartChar = nPos - 1 nRightEndChar = nPos + nSepCharCount If IsNumeric(Mid(sTemp, nLeftStartChar, 1)) And _ IsNumeric(Mid(sTemp, nRightEndChar, 1)) Then Do While nLeftStartChar 1 If Not IsNumeric(Mid(sTemp, _ nLeftStartChar - 1, 1)) Then Exit Do nLeftStartChar = nLeftStartChar - 1 Loop nLeftArg = CLng(Mid(sTemp, nLeftStartChar, _ nPos - nLeftStartChar)) Do While nRightEndChar < Len(sTemp) If Not IsNumeric(Mid(sTemp, _ nRightEndChar + 1, 1)) Then Exit Do nRightEndChar = nRightEndChar + 1 Loop nRightArg = CLng(Mid(sTemp, _ nPos + nSepCharCount, _ nRightEndChar - (nPos + nSepCharCount - 1))) sTemp2 = sDelimiter & CStr(nLeftArg) nStep = Sgn(nRightArg - nLeftArg) If nStep Then For i = nLeftArg + nStep To _ nRightArg Step nStep sTemp2 = sTemp2 & sDelimiter & i bGoodString = Len(sTemp2) <= nMAXCHARS If Not bGoodString Then Exit Do Next i Else nPos = nPos - nSepCharCount End If sTemp = Left(sTemp, nLeftStartChar - 1) & _ Mid(sTemp2, Len(sDelimiter) + 1) & _ Mid(sTemp, nRightEndChar + 1) bGoodString = Len(sTemp) <= nMAXCHARS If Not bGoodString Then Exit Do End If nPos = InStr(nPos + nSepCharCount, sTemp, _ sRangeSeparator) Loop End If End If If bGoodString Then NumberRangeToList = sTemp Else NumberRangeToList = CVErr(xlErrValue) End If End Function In article , CLR wrote: It even works with 1-5, 8-12, 21-19 all in the same cell, returning 1,2,3,4,5,8,9,10,11,12,21,20,19 I don't know when I'll ever use it, but it's going directly into my goodie-stash. |
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
parsing number ranges
It can be used as a UDF:
=NumberRangeToList(A1, "--") =NumberRangeTolist(A1,,".") or as a function within VBA: Dim rCell As Range For Each rCell in Selection With rCell .Value = NumberRangeToList(.Text, "--",",") End With Next rCell In article , CLR wrote: I understood how to use the first one, but have no clue here........ |
#8
Posted to microsoft.public.excel.misc
|
|||
|
|||
parsing number ranges
Well, that's interesting.....thank you very much kind Sir...... Vaya con Dios, Chuck, CABGx3 "JE McGimpsey" wrote: It can be used as a UDF: =NumberRangeToList(A1, "--") =NumberRangeTolist(A1,,".") or as a function within VBA: Dim rCell As Range For Each rCell in Selection With rCell .Value = NumberRangeToList(.Text, "--",",") End With Next rCell In article , CLR wrote: I understood how to use the first one, but have no clue here........ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Preceding a number by zeros, that is still a number | Excel Worksheet Functions | |||
Count Number of Characters in a cell? | Excel Discussion (Misc queries) | |||
Need number of Saturdays and number of Sundays between 2 dates | Excel Worksheet Functions | |||
How to format a number in Indian style in Excel? | Excel Discussion (Misc queries) | |||
Problem with graph ranges | Charts and Charting in Excel |