Changing Orders
Hi Dana,
It's a nice, compact solution, I tried it and it gave the required result,
but I couldn't figure out the logic. Please explain it!
Stefi
€˛Dana DeLouis€¯ ezt Ć*rta:
+ 100 * IIf(letter = "H", 1, IIf(letter = "D", 2, IIf(letter = "S",
3, 4)))
Hi. Just an idea if you want to keep the same logic is to expand the 100
into each of the outputs.
With IIF, each letter is generated.
Perhaps one idea:
+ 9368050 Mod (Asc(letter) + 447)
--
Dana DeLouis
"Stefi" wrote in message
...
Hi Geoff,
I tested again my function and found a typo in it indeed:
If Right(strchr, 1) = "0" And Right(strchr, 1) <= "9" Then _
strchr = Mid(origstr, codepos, 31)
is wrong, the correct line is
If Right(strchr, 1) = "0" And Right(strchr, 1) <= "9" Then _
strchr = Mid(origstr, codepos, 3)
With this correction the function deals with strings starting by 13S as
well.
Thanks for your contribution!
Regards,
Stefi
€˛Geoff€¯ ezt Ć*rta:
The previous solution only parses the string in twos therfore will fail
if
the code number starts with for example 13C
I would suggest the following adaptation:
Sub test()
Dim tbl2 As Variant
Dim j As Long
tbl2 = range(Cells(1, 1), Cells(Cells(Rows.Count,
"A").End(xlUp).Row, 1))
For j = LBound(tbl2, 1) To UBound(tbl2, 1)
If Not tbl2(j, 1) = "" Then tbl2(j, 1) = ReOrder(tbl2(j, 1))
Next j
range(Cells(1, 2), Cells(Cells(Rows.Count, "A").End(xlUp).Row, 2)) =
tbl2
End Sub
Function ReOrder(origstr) As String
Dim strarr(4)
Dim weightarr(4)
Dim resultarr(4)
Dim codepos As Long
Dim strchr As String
Dim i As Long, j As Long
Dim letter As String
Dim arrmin As Long
Dim minpos As Long
Dim sChar As String
Dim sStr(4)
i = 0
For j = 0 To 4
For i = i + 1 To Len(origstr)
sChar = Mid(origstr, i, 1)
If sChar Like "*[HDSC]*" Then
sStr(j) = sStr(j) & sChar
Exit For
End If
If Not sChar Like "*[!0-9]*" Then sStr(j) = sStr(j) & sChar
Next i
Next j
codepos = 1
j = 0
For i = 1 To 5
strchr = sStr(j)
codepos = codepos + Len(strchr)
strarr(i - 1) = strchr
letter = Right(strchr, 1)
weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
100 * IIf(letter = "H", 1, IIf(letter = "D",
2,
IIf(letter = "S", 3, 4)))
j = j + 1
Next i
For i = 1 To 5
arrmin = WorksheetFunction.Min(weightarr)
minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
resultarr(i - 1) = strarr(minpos - 1)
weightarr(minpos - 1) = 1000
Next i
ReOrder = Join(resultarr, "")
End Function
hth
Geoff
"Stefi" wrote:
Try this USF as a possible solution:
Function ReOrder(origstr)
Dim strarr(4)
Dim weightarr(4)
Dim resultarr(4)
codepos = 1
For i = 1 To 5
strchr = Mid(origstr, codepos, 2)
If Right(strchr, 1) = "0" And Right(strchr, 1) <= "9" Then _
strchr = Mid(origstr, codepos, 31)
codepos = codepos + Len(strchr)
strarr(i - 1) = strchr
letter = Right(strchr, 1)
weightarr(i - 1) = Val(Left(strchr, Len(strchr) - 1)) + _
100 * IIf(letter = "H", 1, IIf(letter = "D", 2,
IIf(letter =
"S", 3, 4)))
Next i
For i = 1 To 5
arrmin = WorksheetFunction.Min(weightarr)
minpos = WorksheetFunction.Match(arrmin, weightarr, 0)
resultarr(i - 1) = strarr(minpos - 1)
weightarr(minpos - 1) = 1000
Next i
ReOrder = Join(resultarr, "")
End Function
Sub test()
x = ReOrder(Range("A1"))
End Sub
Regards,
Stefi
€˛James8309€¯ ezt Ć*rta:
Hi everyone,
I have bunch of codes in this structu
-'N''A' , where N = Number from 1 to 13, A = Alaphabet H,D,S,C
in each cell, I have 5 of codes above combined together.
e.g. 1D3S4C3D13S
Problem is, those Alphabet codes and numbers have orders.
i.e.
Condition 1. H D S C, if it is bigger, it needs to be
positioned
left side.
Condition 2. 1 is the biggest 13 is the smallest same rule applies.
so if I have this code in cell A1 for an example : 5H8C3D1D13S
this should really be arranged as 5H1D3D3S8C because H is the first
priority 5H comes very first, 1D comes before 3D because number 1
is
higher priority than 3 and they came before 3S because of the
alphabet
code 'D'.
if I have an empty cell A1 (this is where I will be putting these
5codes in random order), how do i make it arrange it properly and
display in B1 automatically according to those two conditions?
thank you for your help in advance.
regards,
James
|