none
VBA Excel => How to Add Exception for Text Segmentation Code RRS feed

  • Question

  • Hi,

    Some time before I found an EXCEL Forum with a thread regarding "Text Segmentation" showing this code (by Sascha Oliver Haak at SAOLHA)

    Sub TextZeilenErstellen()
    Application.ScreenUpdating = False
       
        iZeile = 0         ' Text segmentation result will be here
        iSpalte = 2         ' Text segmentation result will be here
        icount = 1
       
       
        While icount < Range("A65536").End(xlUp).Row + 1
            iM = 1: Text$ = Cells(icount, 1)
            icount = icount + 1
            If Len(Trim(Text$)) > 1 Then
               For f = 1 To Len(Text$)
                    Select Case Mid$(Text$, f, 1)
                        Case ".", ";", ":", "!", "?"
                        iZeile = iZeile + 1
                        Cells(iZeile, iSpalte) = Trim(Mid$(Text$, iM, f - iM + 1))
                        iM = f + 1
                    End Select
                Next f
            End If
            If f > iM Then iZeile = iZeile + 1: Cells(iZeile, iSpalte) = Trim(Mid$(Text$, iM, f - iM + 1))
        Wend
    Application.ScreenUpdating = True
    

    My question is, how to add some exceptions to this formula, so that for example, the text will not be segmentated after

    "etc.", "1.", "2.", "3 ... 4.", "e.g." and so on?

    Thanks in advance!        : )

    Sunday, November 3, 2013 8:37 PM

All replies

  • Sub TextZeilenErstellen2()
        Application.ScreenUpdating = False

        iZeile = 0         ' Text segmentation result will be here
        iSpalte = 2         ' Text segmentation result will be here
        icount = 1


        While icount < Range("A65536").End(xlUp).Row + 1
            iM = 1: Text$ = Cells(icount, 1)
            icount = icount + 1
            If Len(Trim(Text$)) > 1 Then
                For f = 1 To Len(Text$)
                    Select Case Mid$(Text$, f, 1)
                    Case ".", ";", ":", "!", "?"
                        iAsc = Asc(Mid$(Text$, f - 1, 1))

    'Check for exceptions:

                       If Not (iAsc >= 48 And iAsc <= 57) And _
                           (Mid$(Text$, f - 3, 3) <> "etc") And _
                           (Mid$(Text$, f - 3, 3) <> "e.g") And _
                           (Mid$(Text$, f - 1, 3) <> "e.g") Then
                            iZeile = iZeile + 1
                            Cells(iZeile, iSpalte) = Trim(Mid$(Text$, iM, f - iM + 1))
                            iM = f + 1
                        End If
                    End Select
                Next f
            End If
            If f > iM Then iZeile = iZeile + 1: Cells(iZeile, iSpalte) = Trim(Mid$(Text$, iM, f - iM + 1))
        Wend
        Application.ScreenUpdating = True
    End Sub

    Monday, November 4, 2013 1:46 PM
  • Hello Bernie,

    Thanks.

    However, I receive "Invalid procedure call or argument" when I run this code in Excel (ALT+F8)

    Monday, November 4, 2013 3:27 PM
  • Sorry - I did not put in error checking - if f is 3 or less, then the Mid blows up. To fix that, change

            iM = 1: Text$ = Cells(icount, 1)

    to

            iM = 1: Text$ = "   " & Cells(icount, 1)

    Monday, November 4, 2013 3:33 PM
  • Thanks, it's working... : )

    For example, it delivers the all sentence without line break:

    "1. This is only an example for several languages at the same time usw.usw. etc. ok, 1. it's done!"

    I also added some exceptions:

    Sub TextZeilenErstellen2()
        Application.ScreenUpdating = False
    
        iZeile = 0         ' Text segmentation result will be here
        iSpalte = 2         ' Text segmentation result will be here
        icount = 1
    
    
        While icount < Range("A65536").End(xlUp).Row + 1
            iM = 1: Text$ = "   " & Cells(icount, 1)
            icount = icount + 1
            If Len(Trim(Text$)) > 1 Then
                For f = 1 To Len(Text$)
                    Select Case Mid$(Text$, f, 1)
                    Case ".", ";", ":", "!", "?"
                        iAsc = Asc(Mid$(Text$, f - 1, 1))
    
    'Check for exceptions:
    
                       If Not (iAsc >= 48 And iAsc <= 57) And _
                           (Mid$(Text$, f - 3, 3) <> "usw") And _
                           (Mid$(Text$, f - 3, 3) <> "z.B") And _
                           (Mid$(Text$, f - 1, 3) <> "z.B") Then
                           (Mid$(Text$, f - 3, 3) <> "etc") And _
                           (Mid$(Text$, f - 3, 3) <> "e.g") And _
                           (Mid$(Text$, f - 1, 3) <> "e.g") Then
                            iZeile = iZeile + 1
                            Cells(iZeile, iSpalte) = Trim(Mid$(Text$, iM, f - iM + 1))
                            iM = f + 1
                        End If
                    End Select
                Next f
            End If
            If f > iM Then iZeile = iZeile + 1: Cells(iZeile, iSpalte) = Trim(Mid$(Text$, iM, f - iM + 1))
        Wend
        Application.ScreenUpdating = True
    End Sub
    

    Monday, November 4, 2013 3:52 PM
  • That should not work - you have an extra "Then"  which should be "And _"  

    If Not (iAsc >= 48 And iAsc <= 57) And _
                           (Mid$(Text$, f - 3, 3) <> "usw") And _
                           (Mid$(Text$, f - 3, 3) <> "z.B") And _
                           (Mid$(Text$, f - 1, 3) <> "z.B") Then
                           (Mid$(Text$, f - 3, 3) <> "etc") And _
                           (Mid$(Text$, f - 3, 3) <> "e.g") And _
                           (Mid$(Text$, f - 1, 3) <> "e.g") Then
                            iZeile = iZeile + 1


    If Not (iAsc >= 48 And iAsc <= 57) And _
                           (Mid$(Text$, f - 3, 3) <> "usw") And _
                           (Mid$(Text$, f - 3, 3) <> "z.B") And _
                           (Mid$(Text$, f - 1, 3) <> "z.B") And _
                           (Mid$(Text$, f - 3, 3) <> "etc") And _
                           (Mid$(Text$, f - 3, 3) <> "e.g") And _
                           (Mid$(Text$, f - 1, 3) <> "e.g") Then
                            iZeile = iZeile + 1

    Monday, November 4, 2013 4:27 PM
  • It works the same, but you are right: that's a syntax error (I just copied and pasted without looking after).

    Once again thanks. This is better als SoDoKu...   ; )

    Monday, November 4, 2013 8:56 PM