[發問] 儲存內的 １ 一 都輚成半型的１

pinklee

有４個儲存格分別如下
ＸＸ街十二巷一號
ＸＸ路１２巷１號
ＸＸ街十二巷１號
ＸＸ路１２巷一號

怎麼做到都會轉成

ＸＸ路12巷1號

國字　數字全型　都轉成半型的數字呢　感謝您

oobird

Sub yy()
For Each c In ActiveSheet.UsedRange
c.Value = StrConv(c.Value, vbNarrow, LocaleID)
Next
End Sub

pinklee

回復 2# oobird


   謝謝  oobird  但是只有阿拉伯數字全型轉半型耶 一 沒有成 半型的1
十一巷 -> 11巷
程式精簡 佩服!

Hsieh

回復 3# pinklee
國字的數值要轉成數字會有習慣不同的問題
例如:12若是標準應以一十二才能與二十以上文數字配合
若以數字直接編譯則應為一二
要以口語化轉譯似乎有困難

pinklee

回復 4# Hsieh


    說的是  有時也要將就一下習慣  再回頭 把文字上的  一十二  改成  十二  呵呵  官大的人都有不同的想法  謝啦

oobird

難度頗高，例如
二十一 = 21 ~十替換為空
十五 = 15 ~十替換為1
十 = 10 ~十替換為10

pinklee

ＸＸ街二十二巷1號
ＸＸ街一十二巷一十號
ＸＸ路１２巷１號
ＸＸ街一十二巷１號
ＸＸ路１２巷二一號
ＸＸ街一十巷1號
ＸＸ街一十巷1號

用了各位先進指教的 亂做了一下下
Sub ttt()
Dim a, b As String

For Each C In ActiveSheet.UsedRange
C.Value = StrConv(C.Value, vbNarrow, LocaleID)
Next

For i = 1 To 10 Step 1
a = "一二三四五六七八九十"
b = "123456789十"
Cells.Replace Mid(a, i, 1), Mid(b, i, 1)
Next

a = "十巷十弄十號"
b = "0巷0弄0號"
For i = 1 To 6 Step 2
Cells.Replace Mid(a, i, 2), Mid(b, i, 2)
Next

a = "十"
b = ""
For i = 1 To 1
Cells.Replace Mid(a, i, 1), Mid(b, i, 1)
Next
End Sub

結果如下
XX街22巷1號
XX街12巷10號
XX路12巷1號
XX街12巷1號
XX路12巷21號
XX街10巷1號
XX街10巷1號
似乎可行

Hsieh

回復 7# pinklee


    如果國數字的寫法與格式DBNum1相同可試試
預設最大數字為2000(因為號碼有超過1000號的地址)
可自行設定

1. Sub nn()
   
2. Dim C As Range
   
3. For i = 2000 To 1 Step -1
   
4. k = Application.Text(i, "[DBNum1]")
   
5.   Cells.Replace k, i
   
6. Next
   
7. For Each C In ActiveSheet.UsedRange
   
8. C.Value = StrConv(C.Value, vbNarrow, LocaleID)
   
9. Next
   
10. End Sub

複製代碼

pinklee

回復 8# Hsieh


    高手出招 的確不凡 簡潔
測了一下 如果是十二巷 不是一十二巷 無法轉換十 會轉成

ＸＸ街十二巷１號 ->XX街十2巷1號
謝了

Hsieh

回復 9# pinklee

不是說了要以DBNUM1格式為前提嗎?
若有兩種可能
如:12=> 一十二
    或十二
    或一二

1. Sub nn()
   
2. Dim C As Range
   
3. With ActiveSheet.UsedRange
   
4. For i = 200 To 1 Step -1
   
5. k = Application.Text(i, "[DBNum1]")
   
6. m = Application.Text(i, "[DBNum1]0")
   
7.   .Cells.Replace m, i
   
8.   .Cells.Replace k, i
   
9.   If Int(i / 10) = 1 Then .Cells.Replace Mid(k, 2), i
   
10. Next
    
11. For Each C In .Cells
    
12. C.Value = StrConv(C.Value, vbNarrow, LocaleID)
    
13. Next
    
14. End With
    
15. End Sub

複製代碼