麻辣家族討論版版 - Powered by Discuz! Board

標題: 處理STRING時遇到困難 [打印本頁]

作者: 小俠客 時間: 2012-8-23 22:49 標題: 處理STRING時遇到困難

近日在寫一些FUNCTION來處理文字，可是遇到不少困難，請各位幫忙一下：

目標：寫一個叫WORD的FUNCTION，效果是要找出字串中目標字眼，類似INSTR，但不同。例如：
STR = "Now is the time"
word(str, 1)= Now
word(str, 2)= is

Sub Word()
Dim str As String
Dim str_out As String
Dim i As Integer, j As Integer, c As Integer, a As Integer
str = "Now is the time"
str = Trim(str)
str_out = ""
a = 3
c = 0
For i = 1 To Len(str)
If c = a - 1 Then
For j = i To Len(str)
If Mid(str, j, 1) <> " " Then
str_out = str_out & Mid(str, j, 1)
Else
Exit For
End If
Next j
i = j
If InStr(Mid(str, j), " ") <> 0 Then
i = j
c = c + 1
Else
i = j
End If
End If
If Mid(str, i, 1) <> " " Then
For j = i To Len(str)
If InStr(Mid(str, j), " ") = 0 Then
i = Len(str)
ElseIf Mid(str, j, 1) = " " Then
i = j
Exit For
End If
Next j
c = c + 1
End If
Next i
MsgBox str_out

複製代碼

這段CODE是可以處理文字之間只有一個空格的字串，但如何字串變成："Now is the time"
這個便不行了，不知道各位有沒有方法解決？謝謝大家

作者: white945 時間: 2012-8-23 23:09

回復 1# 小俠客

Function TRIM_Str(Mystr As String) As String
Dim Ay()
ar = Split(Mystr, " ")
For Each a In ar
If a <> "" Then
ReDim Preserve Ay(s)
Ay(s) = a
s = s + 1
End If
Next
TRIM_Str = Join(Ay, " ")
End Function
Sub nn()
MsgBox TRIM_Str("Now is the time")
End Sub

複製代碼

作者: 小俠客 時間: 2012-8-24 00:13

謝謝大大，雖然你寫的代碼跟我的原意有點不同，因為我的目的是抽取某一個詞，例如：WORD("我是一個男生", 3) = 一個，跟MID有點似，但我是以詞組為基礎。
我把你的理念加入，成功製成了WORD這個FUNCTION了。

我之前也試過用"SPLIT"這個功能，但我一直以為SPLIT的用法是把字串拆開，再放入列陣中，例如：A()=SPLIT(STRING, " ")
我把SPLIT放在上面的CODE時，發現了有部份的列陣是空的，想不到原來可以用REDIM PRESERVE刪去，太利害了，又多學一個方法，謝謝。

作者: white945 時間: 2012-8-24 00:20

回復 3# 小俠客
Sorry!!沒看清楚你的用意

Function TheWord(Mystr As String, dot As String, i As Integer) As String
Dim Ay()
ar = Split(Mystr, dot)
For Each a In ar
If a <> "" Then
ReDim Preserve Ay(s)
Ay(s) = a
s = s + 1
End If
Next
TheWord = Ay(i - 1)
End Function
Sub nn()
Dim i As Integer
For i = 1 To 4
MsgBox TheWord("Now is the time", " ", i)
Next
End Sub

複製代碼

作者: GBKEE 時間: 2012-8-24 12:05

本帖最後由 GBKEE 於 2012-8-24 12:07 編輯

回復 3# 小俠客

Option Explicit
Sub Ex()
Dim TheWord As String, xW As String, E
xW = "a"
TheWord = "我aaaaa是aaaaa一個aaaaaaaaa男生"
Do
TheWord = Replace(TheWord, String(2, xW), xW)
Loop While InStr(TheWord, String(2, xW)) '= True
For Each E In Split(TheWord, xW)
MsgBox E
Next
End Sub

複製代碼

作者: 小俠客 時間: 2012-8-27 17:09

回復 4# white945

十分感謝，這是正我需要的功能

作者: 小俠客 時間: 2012-8-27 17:29

回復小俠客
GBKEE 發表於 2012-8-24 12:05

我也用過REPLACE，但當處理多於一個SPACE或特別符號時就會出問題，原來可以用STRING + LOOP的方法
受教了。

另外，我可以多問一個問題嗎？是關於分析字串時多條件選擇的問題
例如：我要受訪者回答他子女的學校區分和學歷，如果沒有子女，答案留空，轉答下一題

If Ien(raw.Cells(i, 3)) > 0 Then
If InStr(raw.Cells(i, 3), "小學") + InStr(raw.Cells(i, 3), "初小") > 0 Then
type = "primary"
GoTo Define_unit
ElseIf InStr(raw.Cells(i, 3), "初中") + InStr(raw.Cells(i, 3), "國中")+ InStr(raw.Cells(i, 3), "高中") > 0 Then
type = "secondary"
GoTo Define_unit
ElseIf InStr(raw.Cells(i, 3), "大學") + InStr(raw.Cells(i, 3), "大專")> 0 Then
type = "Uni"
GoTo Define_unit
ElseIf InStr(raw.Cells(i, 3), "研究所") + InStr(raw.Cells(i, 3), "博士") > 0 Then
type = "Master+"
GoTo Define_unit
End If
Define_unit:
If InStr(raw.Cells(i, 3), "台灣") > 0 Then unit = "TW"
If InStr(raw.Cells(i, 3), "香港") > 0 Then unit = "HK"
If InStr(raw.Cells(i, 3), "美國") > 0 Then unit = "US"
End If

複製代碼

例如：答案是，我兒子是在美國讀高中
那麼unit = "US", TYPE=secondary

但這裡有很多IF THEN，又太長，有點混亂。我將之改用GOTO，不用重複出現幾次相似的句子。但請問可以改用select case或其他方法簡化嗎？謝謝

作者: GBKEE 時間: 2012-8-27 20:26

本帖最後由 GBKEE 於 2012-8-28 09:15 編輯

回復 7# 小俠客

If InStr(raw.Cells(i, 3), "小學") + InStr(raw.Cells(i, 3), "初小") > 0 Then
'條件 : 如不成立, 會判斷下一個ElseIf條件.一直到有ElseIf條件成立後會不再去判斷其餘的條件,離開此 IF ....Then ....Else ..... End If
'不必 GoTo Define_unit
vbtype = "primary"
ElseIf InStr(raw.Cells(i, 3), "初中") + InStr(raw.Cells(i, 3), "國中") + InStr(raw.Cells(i, 3), "高中") > 0 Then
vbtype = "secondary"
ElseIf InStr(raw.Cells(i, 3), "大學") + InStr(raw.Cells(i, 3), "大專") > 0 Then
vbtype = "Uni"
ElseIf InStr(raw.Cells(i, 3), "研究所") + InStr(raw.Cells(i, 3), "博士") > 0 Then
vbtype = "Master+"
End If
If InStr((raw.Cells(i, 3), "台灣") > 0 Then unit = "TW"
If InStr((raw.Cells(i, 3), "香港") > 0 Then unit = "HK"
If InStr((raw.Cells(i, 3), "美國") > 0 Then unit = "US"

複製代碼

作者: 小俠客 時間: 2012-8-27 22:29

回復小俠客
GBKEE 發表於 2012-8-27 20:26

這個W是要用
set w = raw.cells(i,3)
來設定嗎？
原來如此，謝謝版大

這麼，是不是select case只能用一個condition?

作者: GBKEE 時間: 2012-8-28 09:44

本帖最後由 GBKEE 於 2012-8-28 09:48 編輯

回復 9# 小俠客
InStr(raw.Cells(i, 3), "小學") 這只會傳回數字
你自串中初小, 小學,初中, 國中.... 並沒有固定在哪個位置,不適合用 Select Case

Select Case 變數 '
Case 數字或字串
End Select

複製代碼

作者: 小俠客 時間: 2012-8-29 12:12

回復小俠客
InStr(raw.Cells(i, 3), "小學") 這只會傳回數字
你自串中初小, 小學,初中, 國中.... ...
GBKEE 發表於 2012-8-28 09:44

我忽然想到，如果我把小學、中學、大學、研究生以上的類別用array儲起來，用FOR LOOP + select case 或if是不是可以？
例如：

scl(1,1) = "初小"
scl(1,2) = "小學"
scl(2,1) = "初中"
scl(2,2) = "高中"
scl(3,1) = "大學"
.
.
.
edu(1)="小學"
edu(2)="中學"
edu(3)="大學"
.
.
for j = 1 to 4
for k = 1 to 2
select case instr(raw.Cells(i, 3), scl(j,k))
case >0
vbtype=edu(j)
end select
next k
next j

複製代碼

但如果sub中放了太多的array，會有點混亂，而且類似的array在其他的sub 也會用到，如果在每一個sub都存有相同的array，維護時也很麻煩，所以我打算用public const去define array，但失敗了。

我的做法是：

public dim scl(4,2) as string
const dim scl(1,1) = "初小"
const scl(1,2) = "小學"
.

sub abc()

是不是不能在public define 2dimensional的 array？

作者: GBKEE 時間: 2012-8-29 13:08

本帖最後由 GBKEE 於 2012-8-29 13:09 編輯

回復 11# 小俠客

Option Explicit
Public scl, edu '此公用變數可供其他程序使用
Private Sub Workbook_Open() ' Workbook_Open 是ThisWorkbook 模組的程式碼
設立陣列
End Sub
Sub 設立陣列() '在此設立陣列可供其他程序使用
ReDim scl(1 To 3, 1 To 2)
ReDim edu(1 To 3)
scl(1, 1) = "初小"
scl(1, 2) = "小學"
scl(2, 1) = "初中"
scl(2, 2) = "國中"
scl(3, 1) = "大學"
scl(3, 2) = "專科"
edu(1) = "小學"
edu(2) = "中學"
edu(3) = "大學"
End Sub
Sub Ex() '執行 "設立陣列" 程序後可執行此程序
Dim j, k, w, vbtype
w = "--國中**"
For j = 1 To UBound(scl)
For k = 1 To UBound(scl, 2)
If InStr(w, scl(j, k)) Then vbtype = edu(j): GoTo Define_unit
Next k
Next j
Define_unit:
MsgBox vbtype
End Sub

複製代碼

作者: 小俠客 時間: 2012-8-29 23:47

回復小俠客
GBKEE 發表於 2012-8-29 13:08

嘩！我在網上四處找"excel vba public const array"，只能找到1 dimension array的設定方法
原來還有這一招，又學起來了，謝謝版大

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)