Question

VB中字符串拆分问题

Private Sub Command1_Click()
Dim strArr() As String, strSubLine() As String, strLine() As String
Dim i As Long, j As Long, k As Long, p As Long, n As Long
Dim isChinese As Boolean

Dim strSource As String

strSource = "我爱我家I love my home。哪里there。"

ReDim strArr(Len(strSource) - 1)

strLine = Split(strSource, "?￡")

For i = 0 To UBound(strLine)
strSubLine = Split(strLine(i), "￡?")
For j = 0 To UBound(strSubLine)
p = 1
For k = 1 To Len(strSubLine(j))
If k = 1 Then
isChinese = (Asc(Mid(strSubLine(j), 1, 1)) < 0)
Else
If (Asc(Mid(strSubLine(j), k, 1)) > 0 And isChinese) Or (Asc(Mid(strSubLine(j), k, 1)) < 0 And Not isChinese) Then
isChinese = Not isChinese
strArr(n) = Mid(strSubLine(j), p, k - p)
n = n + 1
p = k
End If
End If
Next k

strArr(n) = Mid(strSubLine(j), p, k - p)
n = n + 1
Next j
Next i

ReDim Preserve strArr(n - 1)

For i = 0 To n - 1
Debug.Print strArr(i)
Next i
End Sub
我想把上面那句话拆成 “我爱我家” “I love my home” “。” “那里” “。” “there” “。”可是运行后“。那里”这个句号和那里连在一起了！求大神指教该怎么更改！

Answer 1

如果是固定的这个个字串，你可以直接用长度来截取子字串

追问

不是就这个字符串的！是个动态的字符串。这个只是做个比喻！愁死我了！

追答

动态字串的规则是什么，如果无法描述就给出几个例子来

追问

没有什么具体的规则，就是一个一段文字，里面包含着英文 汉语 标点符号！需要把这段文字中的英文 汉子 标点符号分别提取出来按顺序存到一维数组中！

追答

这个简单，用正则获取
([\u4E00-\u9FA5])* 获取中文
(\w)* 获取西文
[。！，？]* 获取标点符号

追问

排序呢,要怎么办，我需要把他们按照语句中的顺序存入到一个一维数组中！当时我想到这个了在这步这里有卡住了！

追答

这个顺序无法得知，所以唯一的办法就是你根据与原字串比较，获得其先后顺序

Answer 2

如果说没有规律，那么要考虑标点符号应该罗列！并且还要考虑西文或中文的标点符号之区别。
比如：
西文的标点符号有：, . ; : ' ' !等等
中文的标点符号有：， 。；：‘ ” ！等等，都是不一样的。
假设，你的字符串除了这三种外，没有其他字符，可以......

Answer 3

下面的可以实现你的需求。
Private Sub Command1_Click()
Dim strSource As String, strArr() As String
Dim i As Long, j As Long, k As Long
Dim oldStyle As Integer, newStyle As Integer

j = -1
oldStyle = -1

strSource = "我爱我家I love my home。哪里there。"
k = Len(strSource)
For i = 1 To k
strSelText = Mid(strSource, i, 1)
If InStr("abcdefghijklmnopqrstuvwxyz ", LCase(strSelText)) > 0 Then
newStyle = 0
ElseIf strSelText = "。" Then '如需支持识别其它标点，此行可改成：ElseIf InStr("，。、！？：；“”‘’《》（）—…",strSelText)>0 Then
newStyle = 1
Else
newStyle = 2
End If
If newStyle <> oldStyle Then
j = j + 1
ReDim Preserve strArr(j) As String
oldStyle = newStyle
End If
strArr(j) = strArr(j) & strSelText
Next

k = UBound(strArr)
For i = 0 To k
Debug.Print strArr(i)
Next
End Sub