Board logo

標題: [發問] 求一次修正姓名輸入模式的公式 [打印本頁]
作者: hkyan    時間: 2018-9-5 16:03     標題: 求一次修正姓名輸入模式的公式

本帖最後由 hkyan 於 2018-9-5 16:05 編輯

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

[attach]29349[/attach]
作者: faye59    時間: 2018-9-6 06:46

回復 1# hkyan


="MR"&SUBSTITUTE(MID(A1,4,99),",","")
下拉
作者: hkyan    時間: 2018-9-6 12:11

回復 2# faye59

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

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

回復 3# hkyan


文字粘在一起, 無分隔符號, 公式是無法判別的!!
作者: faye59    時間: 2018-9-6 22:16

回復 3# hkyan


    不然用vba試試，
[attach]29358[/attach]
用了笨一點的方法達到你要的效果。
  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    時間: 2018-9-7 11:43

回復 5# faye59

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

倘若名稱舊有輸入為 CHING, LOK-MAN需修正為 CHING LOK MAN,那麼多條件取替要如何設置才能同時處理 , 及 -
作者: hkyan    時間: 2018-9-7 12:37

回復 6# hkyan


CHING, LOK-MAN需修正為 CHING LOK MAN才是
作者: faye59    時間: 2018-9-9 21:14

回復 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    時間: 2018-9-9 21:34

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



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