![]() |
#1
|
|||
|
|||
![]()
hi, I have macro, like this
Code:
Sub DemoOrigDoc() Dim oOrigDoc 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 oOrigDoc.Content.Cut oOrigDoc.Content.Paste 'some quick and dirty formatting for readability With oOrigDoc.Content .Font.Name = "Arial" .Font.Size = 12 .ParagraphFormat.SpaceAfter = 0 .ParagraphFormat.SpaceBefore = 0 End With 'go through all our paragraphs For Each oPara In oOrigDoc.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 = 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 I use this macro for solving this problem B09=01 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 becomes B09=01 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 but now, the problem is my data has different condition like this: B01=08?2839x5.5.15/4174x3.4.5/36x5/300.00x3/9293x5/717.753.789x2/58x30/28.82.38.83.13.31.472.72x5/9373x5.10.15/07x20/107.03x5 so, "?" replaces "enter"... If I used the macro above, there will be repetition of the data.. so, I'm wondering the macro can work for both condition. Really hope someone can help me with this probkem. further information is from the previous thread HTML Code:
https://www.msofficeforums.com/word-vba/14116-separate-digits-into-3-combinations.html#post38985 Any hope would be great, thank you.. Kind Regards |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Updating links | tkondaks | Word | 2 | 08-28-2012 06:22 AM |
![]() |
mskeithas | Word | 3 | 04-18-2012 12:28 AM |
Updating Links | johnp | Word | 0 | 10-18-2011 03:36 PM |
![]() |
Nigel1985 | Word | 1 | 05-27-2010 07:19 PM |
![]() |
djurmann | PowerPoint | 2 | 12-21-2009 04:26 AM |