另外移动资费越下降，你上网的流量越大。2018年2月份我们每个用户的上网流量是多少？2.6个G，是2017年的同期的150%，2018年2月份的流量是2017年2月份流量的1.5倍，翻上去了，所以你越用得容易，你的流量越高，你的资费就越高。当然总理还是希望进一步的提速降费

程序代码：

Option Explicit

Const 词表文件 = "d:\词表.txt"

Private Type 词结构
    Count  As Long          '该长度的词的个数
    strT() As String        '词
End Type

Dim cb() As 词结构          '词表数组
Dim CbCount As Long         '词表有几个数组

Private Sub Command1_Click()
Call 读词表(词表文件)

Dim s As String, s1 As String

Dim i As Long, o As Long, L As Long
Dim FYN As Boolean

s1 = Text1.text
Text2.text = ""

    L = Len(s1)

Do
    '查找数字
    s = Left(s1, 1)
    If Asc(s) > 0 Then          '非汉字
        For i = 2 To L
            s = Mid(s1, i, 1)
            If Asc(s) < 0 Then Exit For
        Next i
    
        s = Left(s1, i - 1)
        s1 = Mid(s1, i)         '保留剩余部分，如果s用掉了全部，会变成只保留到空
        Text2.text = Text2.text & vbCrLf & s
        L = Len(s1)
    End If
    
    '-------找词--------
    For i = CbCount To 2 Step -1            '从最大的词表比较起
        If cb(i).Count > 0 And L >= i Then  '加一个限制长度，减少运算量
            s = Left(s1, i)
            FYN = False
            For o = 1 To cb(i).Count
                If s = cb(i).strT(o) Then   '查找
                    FYN = True              '设置找到
                    Exit For                '因为有二层循环，所以不能直接处理，一层一层的跳
                End If
            Next o
            If FYN Then         '找到
                s1 = Mid(s1, i + 1)
                Text2.text = Text2.text & vbCrLf & s
                s = ""      '置空，用于判断是否是单字
                Exit For
            End If
        End If
    Next i
    
    If Len(s) > 0 Then      '未查找到，单字
        s = Left(s1, 1)
        s1 = Mid(s1, 2)
        Text2.text = Text2.text & vbCrLf & s
    End If
    
    L = Len(s1)
Loop While L > 0



End Sub

Private Sub Form_Load()
Text1.text = "另外移动资费越下降，你上网的流量越大。2018年2月份我们每个用户的上网流量是多少？2.6个G，是2017年的同期的150%，2018年2月份的流量是2017年2月份流量的1.5倍，翻上去了，所以你越用得容易，你的流量越高，你的资费就越高。当然总理还是希望进一步的提速降费"

End Sub


Private Sub 读词表(filename As String)
CbCount = 0
Dim s As String
Dim f() As String
Dim i As Long, o As Long


s = 打开文件(filename)
f = Split(s, vbCrLf)        '分解成每一行

For i = 0 To UBound(f)
    o = Len(f(i))           '取长度
    If o > 1 Then           '长度小于2的统统忽略，这种为空行或单字
        If CbCount < o Then         '如果没这个长度
            CbCount = o             '设置这个长度
            ReDim Preserve cb(CbCount)  '重定义数组
            With cb(CbCount)        '初始化，防止出错
                .Count = 0
                ReDim .strT(.Count)
            End With
        End If
        With cb(o)                      '
            .Count = .Count + 1             '元素+1
            ReDim Preserve .strT(.Count)    '重定义数组
            .strT(.Count) = f(i)            '保存
        End With
    End If
Next i

End Sub


Public Function 打开文件(cs As String) As String
'快速打开文件
Dim fj As Long

If Dir(cs) <> "" Then           '文件存在
    fj = FreeFile()             '产生下一文件号
    Open cs For Binary As #fj       '打开文件
    
        '直接读整个文件的所有的内容,按字节读,并转换为 Unicode 的VB默认字符串类型
        打开文件 = StrConv(InputB$(LOF(fj), #fj), vbUnicode)
    Close #fj
Else
    MsgBox cs & vbCrLf & "文件不存在！", vbCritical, "打开文件"       '提示文件不存在
End If
End Function