Separate the digits into 3 combinations

[Jasa P]

Hi, I have some problems here... Would you mind to help?
I need to separate digits with specs:
1. consist of 4 numbers
2. have 3 multipliers

onto
1. 4digits with first multiplier
2. last 3 digits with second multiplier
3. last 2 digits with third multiplier

For example:

B09=3621.621.21.8639.639.39x10/12x10/0419x2.2.2/20.05.21.00.99x2/78.87.42.57x3/6328x3.4.5/3408x5.5.5/08x5/7934.3870.7369x3.3.7/728.328x3/28x3

become

3621.621.21.8639.639.39x10/12x10/0419x2/419x2/19x2/20.05.21.00.99x2/78.87.42.57x3/6328x3/328x4/28x5/3408x5/408x5/08x5/08x5/7934.3870.7369x3/934.870.369x3/34.70.69x7/728.328x3/28x3

So, basically like this:
0419x2.2.2 --> 0419x2/419x2/19x2
6328x3.4.5 --> 6328x3/328x4/28x5
3408x5.5.5 --> 3408x5/408x5/08x5
7934.3870.7369x3.3.7 --> 7934.3870.7369x3/934.870.369x3/34.70.69x7

For other examples:
A01=2324.3545.2356.5657.2137.6466x4.4.6/3425.3455x3.6.6/132x2.3/4544.31234.4565x4/45.435.56.3/456x3.3

A02=54.45.55.34x4/456.565.676x3/4564.3453.5775.2342x4.5.6/5646.2342.7324.5466.3242x10.20.15/12.23.45.67x5

C05=123.4543.5765.12.67.234x10/2324.4565.4564.1233x5/2423.2344.4563x3.5.5/2342.3435.5675.2342.2424.6577x3.10.12
and so on...

Become

2324.3545.2356.5657.2137.6466x4/324.545.356.657.137.466x4/24.45.56.57.37.66x6/3425.3455x3/425.455x6/25.55x6/132x2.3/4544.31234.4565x4/45.435.56.3/456x3.3

54.45.55.34x4/456.565.676x3/4564.3453.5775.2342x4/564.453.775.342x5/64.53.75.42x6/5646.2342.7324.5466.3242x10/646.342.324.466.242x20/46.42.24.66.42x15/12.23.45.67x5

123.4543.5765.12.67.234x10/2324.4565.4564.1233x5/2423.2344.4563x3/423.344.563x5/23.44.63x5/2342.3435.5675.2342.2424.6577x3/342.435.675.342.424.577x10/42.35.75.42.24.77x12

If you don't mind, the macro could works for entire data, because in the word file, it doesn't consist for 1 or 3 data like samples above, but it consists of a lot of data...

Any help would be great..
Thank you so much for helping... :D





Regards,


Jasa

[Frosty]

So anything with the pattern "x#.#" gets expanded?

[macropod]

Hi Frosty,

You may be insterested in the related discussions at:
http://www.msofficeforums.com/word-vba/12627-vba-code-adding-slash.html
http://www.msofficeforums.com/word-vba/12292-vba-code-changing-capital-letters-become-lower.html

[Jasa P]

So anything with the pattern "x#.#" gets expanded?

Hi Frosty, yap you're right... but those which contain digits that have 4 numbers and three multipliers)... so it's like "x#.#.#"

For more explanations, thanks Paul for reminding me :D, I almost forgot about this one


First, I want to let you know (x) is multiplication. But, dot (.) is sum

My data is processed in Word. I'm using 2 macro:
First macro is for replacing some characters that are unwanted (record macro)
Second macro is for lowering capital (X) and changing (x) after first (x) to dot (.)

Then, the data is processed in Excel. I'm using 1 macro:
This macro is for sum the multiplications, ex:
10.20.30x10/ --> the result is 30
235.458.101x25.20/ --> the result is 135
1120.1135x10/ --> the result is 20

So, numbers before (x) is counted by the sum of dot (.)+1 -->(first result)
Number/s after (x) is counted by the sum of numbers between (x) and slash (/) -->(second result)
The final result is multiplication of first and second result

There are 3 ways for possible numbers before (x)
2 numbers/+dot(.), ex: 01 or 45 etc
3 numbers/+dot(.), ex: 245 or 939 etc
4 numbers/+dot(.), ex: 1174 or 8364 etc

Possible sum after (x)
For 2 numbers before (x) --> 1 sum
For 3 numbers before (x) --> 1 or 2 sum
For 4 numbers before (x) --> 1 or 2 or 3 sum



Thanks for helping Frosty and Paul... :D
Regards,



Jasa

[macropod]

Cross-posted at: http://www.msofficeforums.com/word-vba/14116-separate-digits-into-3-combinations.html
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

[Frosty]

Well, as a brain teaser, I wrote the following basic functionality. It works basically to spit out what is explained in the original post. It's not the prettiest, but it works on the samples provided in this post.

If you've cross-posted elsewhere, please let those people know.


Sub Demo()
Dim sTestText As String

sTestText = "0419x2.2.2"
sTestText = "6328x3.4.5"
sTestText = "3408x5.5.5"
sTestText = "7934.3870.7369x3.3.7"

MsgBox fTransformText(sTestText)
End Sub
Public Function fTransformText(sWhatText As String) As String
Dim sOrigText As String
Dim sLeft As String
Dim aryLeft() As String
Dim sRight As String
Dim aryRight() As String
Dim i As Integer
Dim x As Integer
Dim sReturn As String
Dim sTemp As String
Dim sTemp2 As String

sOrigText = sWhatText
sLeft = Left(sOrigText, InStr(sOrigText, "x") - 1)
sRight = Right(sOrigText, Len(sOrigText) - InStr(sOrigText, "x"))
aryRight = Split(sRight, ".")
aryLeft = Split(sLeft, ".")

For i = LBound(aryRight) To UBound(aryRight)
'put in a divider line
If sReturn <> "" Then
sTemp = "/"
End If
'truncate as many digits off as needed
If UBound(aryLeft) > 0 Then
For x = LBound(aryLeft) To UBound(aryLeft)
If Len(sTemp) > 1 Then
sTemp = sTemp & "."
End If
sTemp = sTemp & Mid(aryLeft(x), i + 1, Len(aryLeft(x)) - i)
Next
Else
sTemp = sTemp & Mid(sLeft, i + 1, Len(sLeft) - i)
End If
sTemp = sTemp & "x" & aryRight(i)
sReturn = sReturn & sTemp
Next

fTransformText = sReturn
End Function

You may need to provide more samples, or you'll need to show how you plan to incorporate this in actually transforming a document. But if this functionality works, then you would be ready for the next step of actually using it.

[Jasa P]

Well, as a brain teaser, I wrote the following basic functionality. It works basically to spit out what is explained in the original post. It's not the prettiest, but it works on the samples provided in this post.

If you've cross-posted elsewhere, please let those people know.


Sub Demo()
Dim sTestText As String

sTestText = "0419x2.2.2"
sTestText = "6328x3.4.5"
sTestText = "3408x5.5.5"
sTestText = "7934.3870.7369x3.3.7"

MsgBox fTransformText(sTestText)
End Sub
Public Function fTransformText(sWhatText As String) As String
Dim sOrigText As String
Dim sLeft As String
Dim aryLeft() As String
Dim sRight As String
Dim aryRight() As String
Dim i As Integer
Dim x As Integer
Dim sReturn As String
Dim sTemp As String
Dim sTemp2 As String

sOrigText = sWhatText
sLeft = Left(sOrigText, InStr(sOrigText, "x") - 1)
sRight = Right(sOrigText, Len(sOrigText) - InStr(sOrigText, "x"))
aryRight = Split(sRight, ".")
aryLeft = Split(sLeft, ".")

For i = LBound(aryRight) To UBound(aryRight)
'put in a divider line
If sReturn <> "" Then
sTemp = "/"
End If
'truncate as many digits off as needed
If UBound(aryLeft) > 0 Then
For x = LBound(aryLeft) To UBound(aryLeft)
If Len(sTemp) > 1 Then
sTemp = sTemp & "."
End If
sTemp = sTemp & Mid(aryLeft(x), i + 1, Len(aryLeft(x)) - i)
Next
Else
sTemp = sTemp & Mid(sLeft, i + 1, Len(sLeft) - i)
End If
sTemp = sTemp & "x" & aryRight(i)
sReturn = sReturn & sTemp
Next

fTransformText = sReturn
End Function

You may need to provide more samples, or you'll need to show how you plan to incorporate this in actually transforming a document. But if this functionality works, then you would be ready for the next step of actually using it.

Hi, Frosty... :D

Thank u for replying...

Ok, so it's the basic, really? :wot wow, i can't believe it. it's basic, but really hard to understand :confused3 . ok... pyuft, haha I don't know what to do with this vba


Yeah, I just posted the same thread in other forum. Should I post the link of this thread to other forum?


I attached the files below... :D

[Jasa P]

Thank you so much Frosty and Paul :)



Regards,


Jasa

[Frosty]

Yes, you should post a link anywhere you've asked this same question back to this post.

I honestly have no idea what you're trying to accomplish, apart from seeing some before and after text.

The basic process is to take my function, and then use VBA code to...
1. Create a copy of the original document.
2. Go through each paragraph of the document...
3. Determine the valid "working" range of that paragraph (looks like it's everything after the soft-return and before the paragraph mark).
4. use the function I wrote to transform each chunk of text between the "/" characters.

HOWEVER, you have a garbage-in-garbage-out problem (which is always the case with string transformation processes).

The code I'm providing you does two things.
1. It appends the "transformed text" after the original text in the new document. You can easily remove this later
2. It prepends "ERROR: " on any phrase which it doesn't expect. Examples -- a phrase which contains "X" instead of "x", a paragraph which doesn't contain a Soft-return (Fg1=16 is an example in your Before doc).

So... you need to figure out how to clean up your original data (replace all "X" with "x"? Ignore paragraphs which don't have a soft-return?) and all of the other issues you see where ERROR shows up.

Continue to try using the DemoTransform routine to throw different strings at the transform function. I assume there will be other issues, as this is probably only a small subset of your before/after requirements.

Sub DemoTransform()
Dim sTestText As String

sTestText = "0419x2.2.2"
sTestText = "6328x3.4.5"
sTestText = "3408x5.5.5"
sTestText = "7934.3870.7369x3.3.7"
'problem strings
sTestText = "Fg1=16"
sTestText = "78.96.86.51.77.44X4"

MsgBox fTransformText(sTestText)
End Sub
Sub DemoNewDoc()
Dim oOrigDoc As Document
Dim oNewDoc As Document
Dim oPara As Paragraph
Dim rngWorking As Range
Dim aryTemp() As String
Dim i As Integer
Dim sNewText As String

'set our original document
Set oOrigDoc = ActiveDocument
Set oNewDoc = Documents.Add

oOrigDoc.Content.Copy
oNewDoc.Content.Paste

'some quick and dirty formatting for readability
With oNewDoc.Content
.Font.Name = "Arial"
.Font.Size = 12
.ParagraphFormat.SpaceAfter = 0
.ParagraphFormat.SpaceBefore = 0
End With


'go through all our paragraphs
For Each oPara In oNewDoc.Paragraphs
'skip any paragraphs which are empty
If Len(oPara.Range) > 1 Then
'initialize the range as the entire paragraph
Set rngWorking = oPara.Range
'move the beginning to the line of text after the soft return
rngWorking.Start = rngWorking.Start + InStr(rngWorking.text, Chr(11))
'and move the end back from the paragraph mark
rngWorking.MoveEnd wdCharacter, -1

'for stepping through-- can remove later
rngWorking.Select

'get an array of our phrases
aryTemp = Split(rngWorking.text, "/")
'and transform each one
For i = 0 To UBound(aryTemp)
aryTemp(i) = fTransformText(aryTemp(i))
Next

'reset our new text variable
sNewText = ""
'and rebuild our new text string
For i = 0 To UBound(aryTemp)
sNewText = sNewText & aryTemp(i)
If i < UBound(aryTemp) Then
sNewText = sNewText & "/"
End If
Next
'append the text for now, separated by a soft-return
'for easier comparison if the tranformation is working correctly
rngWorking.text = rngWorking.text & Chr(11) & sNewText
End If
Next
End Sub
'transform passed in text
'return original text prepended by ERROR: if there is an issue with the text
Public Function fTransformText(sWhatText As String) As String
Dim sOrigText As String
Dim sLeft As String
Dim aryLeft() As String
Dim sRight As String
Dim aryRight() As String
Dim i As Integer
Dim x As Integer
Dim sReturn As String
Dim sTemp As String
Dim sTemp2 As String

sOrigText = sWhatText
On Error GoTo l_err
sLeft = Left(sOrigText, InStr(sOrigText, "x") - 1)
sRight = Right(sOrigText, Len(sOrigText) - InStr(sOrigText, "x"))
aryRight = Split(sRight, ".")
aryLeft = Split(sLeft, ".")

For i = LBound(aryRight) To UBound(aryRight)
'put in a divider line
If sReturn <> "" Then
sTemp = "/"
End If
'truncate as many digits off as needed
If UBound(aryLeft) > 0 Then
For x = LBound(aryLeft) To UBound(aryLeft)
If Len(sTemp) > 1 Then
sTemp = sTemp & "."
End If
sTemp = sTemp & Mid(aryLeft(x), i + 1, Len(aryLeft(x)) - i)
Next
Else
sTemp = sTemp & Mid(sLeft, i + 1, Len(sLeft) - i)
End If
sTemp = sTemp & "x" & aryRight(i)
sReturn = sReturn & sTemp
Next

l_exit:
fTransformText = sReturn
Exit Function
l_err:
sReturn = "ERROR: " & sOrigText
Resume l_exit
End Function