12
返回列表 上一主題 發帖

處理STRING時遇到困難

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-8-23 22:49 | 只看該作者

處理STRING時遇到困難

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

目標：寫一個叫WORD的FUNCTION，效果是要找出字串中目標字眼，類似INSTR，但不同。例如：
STR = "Now is the time"
word(str, 1)= Now
word(str, 2)= is
  1. Sub Word()
  2. Dim str As String
  3. Dim str_out As String
  4. Dim i As Integer, j As Integer, c As Integer, a As Integer

  6. str = "Now is the time"
  7. str = Trim(str)
  8. str_out = ""
  9. a = 3
  10. c = 0


  13. For i = 1 To Len(str)

  15.     If c = a - 1 Then
  16.         For j = i To Len(str)
  17.             If Mid(str, j, 1) <> " " Then
  18.                 str_out = str_out & Mid(str, j, 1)
  19.                 Else
  20.                 Exit For
  21.             End If
  22.         Next j
  23.         i = j
  24.         If InStr(Mid(str, j), " ") <> 0 Then
  25.             i = j
  26.             c = c + 1
  27.         Else
  28.             i = j
  29.         End If
  30.     End If
  31.    
  32.    
  33.     If Mid(str, i, 1) <> " " Then
  34.         For j = i To Len(str)
  35.             If InStr(Mid(str, j), " ") = 0 Then
  36.             i = Len(str)
  37.             ElseIf Mid(str, j, 1) = " " Then
  38.                 i = j
  39.                 Exit For
  40.             End If
  41.         Next j
  42.     c = c + 1
  43.     End If

  45. Next i
  46. MsgBox str_out
複製代碼
這段CODE是可以處理文字之間只有一個空格的字串，但如何字串變成："Now is    the time"
這個便不行了，不知道各位有沒有方法解決？謝謝大家
收藏 分享

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
13#
發表於 2012-8-29 23:47 | 只看該作者
回復  小俠客
GBKEE 發表於 2012-8-29 13:08



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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2012-8-29 13:08 | 只看該作者
本帖最後由 GBKEE 於 2012-8-29 13:09 編輯

回復 11# 小俠客
  1. Option Explicit
  2. Public scl, edu                  '此公用變數 可供其他程序使用   
  3. Private Sub Workbook_Open()  ' Workbook_Open 是ThisWorkbook 模組的程式碼
  4.     設立陣列
  5. End Sub
  6. Sub 設立陣列()  '在此設立陣列 可供其他程序使用   
  7.     ReDim scl(1 To 3, 1 To 2)
  8.     ReDim edu(1 To 3)
  9.     scl(1, 1) = "初小"
  10.     scl(1, 2) = "小學"
  11.     scl(2, 1) = "初中"
  12.     scl(2, 2) = "國中"
  13.     scl(3, 1) = "大學"
  14.     scl(3, 2) = "專科"
  15.     edu(1) = "小學"
  16.     edu(2) = "中學"
  17.     edu(3) = "大學"
  18. End Sub
  19. Sub Ex()   '執行 "設立陣列" 程序後可執行此程序
  20.     Dim j, k, w, vbtype
  21.     w = "--國中**"
  22.     For j = 1 To UBound(scl)
  23.         For k = 1 To UBound(scl, 2)
  24.            If InStr(w, scl(j, k)) Then vbtype = edu(j): GoTo Define_unit
  25.         Next k
  26.     Next j
  27. Define_unit:
  28.     MsgBox vbtype
  29. End Sub
複製代碼

TOP

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
11#
發表於 2012-8-29 12:12 | 只看該作者
回復  小俠客
InStr(raw.Cells(i, 3), "小學")   這只會傳回數字
你自串中 初小, 小學,初中, 國中....  ...
GBKEE 發表於 2012-8-28 09:44



我忽然想到，如果我把小學、中學、大學、研究生以上的類別用array儲起來，用FOR LOOP + select case 或if是不是可以？
例如：
  1. scl(1,1) = "初小"
  2. scl(1,2) = "小學"
  3. scl(2,1) = "初中"
  4. scl(2,2) = "高中"
  5. scl(3,1) = "大學"
  6. .
  7. .
  8. .

  10. edu(1)="小學"
  11. edu(2)="中學"
  12. edu(3)="大學"
  13. .
  14. .

  16. for j = 1 to 4
  17.         for k = 1 to 2
  18.                 select case instr(raw.Cells(i, 3), scl(j,k))
  19.                         case >0
  20.                                 vbtype=edu(j)
  21.                 end select
  22.         next k
  23. 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？

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2012-8-28 09:44 | 只看該作者
本帖最後由 GBKEE 於 2012-8-28 09:48 編輯

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

TOP

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
9#
發表於 2012-8-27 22:29 | 只看該作者
回復  小俠客
GBKEE 發表於 2012-8-27 20:26



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

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2012-8-27 20:26 | 只看該作者
本帖最後由 GBKEE 於 2012-8-28 09:15 編輯

回復 7# 小俠客
  1. If InStr(raw.Cells(i, 3), "小學") + InStr(raw.Cells(i, 3), "初小") > 0 Then  
  2.         '條件 : 如不成立, 會判斷下一個ElseIf條件.一直到有ElseIf條件成立後會不再去判斷其餘的條件,離開此 IF ....Then  ....Else  .....     End If
  3.         '不必   GoTo Define_unit
  4.         vbtype = "primary"                                                                                                            
  5.     ElseIf InStr(raw.Cells(i, 3), "初中") + InStr(raw.Cells(i, 3), "國中") + InStr(raw.Cells(i, 3), "高中") > 0 Then
  6.         vbtype = "secondary"
  7.     ElseIf InStr(raw.Cells(i, 3), "大學") + InStr(raw.Cells(i, 3), "大專") > 0 Then
  8.         vbtype = "Uni"
  9.     ElseIf InStr(raw.Cells(i, 3), "研究所") + InStr(raw.Cells(i, 3), "博士") > 0 Then
  10.         vbtype = "Master+"
  11.     End If
  12.     If InStr((raw.Cells(i, 3), "台灣") > 0 Then unit = "TW"
  13.     If InStr((raw.Cells(i, 3), "香港") > 0 Then unit = "HK"
  14.     If InStr((raw.Cells(i, 3), "美國") > 0 Then unit = "US"
複製代碼

TOP

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
7#
發表於 2012-8-27 17:29 | 只看該作者
回復  小俠客
GBKEE 發表於 2012-8-24 12:05

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

另外，我可以多問一個問題嗎？是關於分析字串時多條件選擇的問題
例如：我要受訪者回答他子女的學校區分和學歷，如果沒有子女，答案留空，轉答下一題
  1. If Ien(raw.Cells(i, 3)) > 0 Then
  2.     If InStr(raw.Cells(i, 3), "小學") + InStr(raw.Cells(i, 3), "初小") > 0 Then
  3.         type = "primary"
  4.         GoTo Define_unit
  5.     ElseIf InStr(raw.Cells(i, 3), "初中") + InStr(raw.Cells(i, 3), "國中")+ InStr(raw.Cells(i, 3), "高中")  > 0 Then
  6.         type = "secondary"
  7.         GoTo Define_unit
  8.     ElseIf InStr(raw.Cells(i, 3), "大學") + InStr(raw.Cells(i, 3), "大專")> 0 Then
  9.         type = "Uni"
  10.         GoTo Define_unit
  11.         
  12.     ElseIf InStr(raw.Cells(i, 3), "研究所") + InStr(raw.Cells(i, 3), "博士") > 0 Then
  13.         type = "Master+"
  14.         GoTo Define_unit
  15.    
  16.     End If
  17.    
  18. Define_unit:
  19.         If InStr(raw.Cells(i, 3), "台灣") > 0 Then unit = "TW"
  20.         If InStr(raw.Cells(i, 3), "香港") > 0 Then unit = "HK"
  21.         If InStr(raw.Cells(i, 3), "美國") > 0 Then unit = "US"
  22.     End If
複製代碼
例如：答案是，我兒子是在美國讀高中
那麼unit = "US", TYPE=secondary

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

TOP

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
6#
發表於 2012-8-27 17:09 | 只看該作者
回復 4# white945


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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2012-8-24 12:05 | 只看該作者
本帖最後由 GBKEE 於 2012-8-24 12:07 編輯

回復 3# 小俠客
  1. Option Explicit
  2. Sub Ex()
  3.     Dim TheWord As String, xW As String, E
  4.     xW = "a"
  5.     TheWord = "我aaaaa是aaaaa一個aaaaaaaaa男生"
  6.     Do
  7.         TheWord = Replace(TheWord, String(2, xW), xW)
  8.     Loop While InStr(TheWord, String(2, xW))  '= True
  9.     For Each E In Split(TheWord, xW)
  10.         MsgBox E
  11.     Next
  12. End Sub
複製代碼

TOP

        靜思自在 : 盡多少本份，就得多少本事。
12
返回列表 上一主題