[發問] 求一次修正姓名輸入模式的公式

hkyan

要把舊資料一次整理,求公式除去豆號及加回MR 在前, 還有之前轉入有少錯誤(豆號後沒有space),有能一次糾正嗎?
[attach]29345[/attach] 希望效果如此

NAME.rar (6.07 KB)

下載次數: 6

2018-9-5 16:04

faye59

回復 1# hkyan


="MR"&SUBSTITUTE(MID(A1,4,99),",","")
下拉

hkyan

回復 2# faye59

處理過程中,問題來了
1) 倘若外藉客沒有中文姓名的, 便會出錯. 例如
CHOU, QUANTAI 修正後變作 MR U QUANTAI

2) 上文提到部份姓名在,號之後沒有space的小錯誤, 是否就不能修正?
現變作這樣MR YIMWAI  LEUNG, 能於公式內一并修正為 MR YIM WAI LEUNG 嗎?

准提部林

回復 3# hkyan


文字粘在一起, 無分隔符號, 公式是無法判別的!!

faye59

回復 3# hkyan


    不然用vba試試，
NAME.rar (22.13 KB)

下載次數: 3

2018-9-6 22:16

用了笨一點的方法達到你要的效果。

1. Private Sub CommandButton1_Click()
   
2. For Each aa In Sheets("工作表1").Range([A1], [A1].End(xlDown)) '讀取A欄全部文字
   
3. For i = 1 To Len(aa)
   
4. If Mid(aa, i, 1) = "," And Mid(aa, i + 1, 1) <> " " Then '逗點後沒有空白執行加入空白
   
5. ar = ar & ", "
   
6. Else
   
7. ar = ar & Mid(aa, i, 1)
   
8. End If
   
9. Next
   
10. aa.Offset(, 1) = StrType(ar)
    
11. ar = ""
    
12. Next
    
13. End Sub
    
14. Function StrType(Mystr)
    
15.    For i = 1 To Len(Mystr)
    
16.      k = AscW(Mid(Mystr, i))
    
17.      Select Case k
    
18.      Case 32 '空格
    
19.      Textstring = Textstring & Mid(Mystr, i, 1)
    
20.      Case 48 To 57 '數字
    
21.      Textstring = Textstring & Mid(Mystr, i, 1)
    
22.      Case 65 To 90, 97 To 122 '英文
    
23.      Textstring = Textstring & Mid(Mystr, i, 1)
    
24.      Case 0 To 47, 58 To 64, 91 To 96, 122 To 255 '符號
    
25.       Textstring = Textstring & ""
    
26.     End Select
    
27.     Next
    
28.    StrType = "MR " & Textstring
    
29.    If Mid(StrType, 4, 1) = " " Then StrType = Mid(StrType, 1, 3) & Mid(StrType, 5, 99) '判斷第四碼是否為空白
    
30. End Function

複製代碼

hkyan

回復 5# faye59

嘗試中, 另一問有關上回教取替,的公式
=SUBSTITUTE(MID(A1,1,99),",","")

倘若名稱舊有輸入為 CHING, LOK-MAN需修正為 CHING LOK MAN,那麼多條件取替要如何設置才能同時處理 , 及 -

hkyan

回復 6# hkyan


CHING, LOK-MAN需修正為 CHING LOK MAN才是

faye59

回復 6# hkyan


    可以搜尋Asc函數字元碼對照表看看，
下面是修改-這個符號，字元碼為45，在Function中的Select Case中加入一個條件即可。
註解我再打詳細一點。

1. Private Sub CommandButton1_Click()
   
2. For Each aa In Sheets("工作表1").Range([A1], [A1].End(xlDown))'迴圈讀取A欄所有資料，往下讀取
   
3. For i = 1 To Len(aa)'迴圈該欄位文字中長度
   
4. If Mid(aa, i, 1) = "," And Mid(aa, i + 1, 1) <> " " Then'如果讀到逗號並確認後方是否不為空白，兩者條件均符合執行逗號後面加入空白，如果條件均不成立當前文字加入ar字串中
   
5. ar = ar & ", "
   
6. Else
   
7. ar = ar & Mid(aa, i, 1)
   
8. End If
   
9. Next
   
10. aa.Offset(, 1) = StrType(ar)'判讀字串完畢後ar中的條件，跳入Function程序，結果回傳aa往右加一格位置
    
11. ar = ""'清空字串
    
12. Next
    
13. End Sub
    
14. Function StrType(Mystr)
    
15.    For i = 1 To Len(Mystr)'迴圈該欄位文字中長度
    
16.      k = AscW(Mid(Mystr, i))'取得的該文字Asc函數轉換字元碼
    
17.      Select Case k'選取字元碼符合Case中哪一個條件
    
18.      Case 32 '空格
    
19.      Textstring = Textstring & Mid(Mystr, i, 1)
    
20.      Case 48 To 57 '數字
    
21.      Textstring = Textstring & Mid(Mystr, i, 1)
    
22.      Case 65 To 90, 97 To 122 '英文
    
23.      Textstring = Textstring & Mid(Mystr, i, 1)
    
24.      Case 0 To 44, 46 To 47, 58 To 64, 91 To 96, 122 To 255 '符號
    
25.       Textstring = Textstring & ""
    
26.      Case 45 '像是這裡 - 這個符號的字元碼為45，在字串中把它改為空格就可以
    
27.      Textstring = Textstring & " "
    
28.     End Select
    
29.     Next
    
30.    StrType = "MR " & Textstring'字串完畢後在字串前加入MR+空格，回傳完整字串
    
31.    If Mid(StrType, 4, 1) = " " Then StrType = Mid(StrType, 1, 3) & Mid(StrType, 5, 99)'如果文字中第四碼這一個字為空白，重新字串1~3及5~最後一碼，等同於刪除第四碼空格
    
32. End Function

複製代碼

這支程序有點偷懶，不好意思...還有很多地方可以精簡的地方...

hcm19522

http://blog.xuite.net/hcm19522/twblog/585336957