我自己写的，分享自定义连字符函数，谢谢！

hgjian

所以请教一下有其他办法代替了，如有  Bug ，高手指点，谢谢！

版本二：自定义连字符函数版本二：可变动区域

1. Option Explicit
   
2. Function phonetic_and_text(quyu As Range)
   
3. '可以用本代码实现 连字符  函数功能，实现 按照单元格区域 连接
   
4.       Application.Volatile
   
5.       Dim xunhuan_cell As Range
   
6.       Dim zuhe
   
7.       zuhe = ""
   
8.       For Each xunhuan_cell In quyu
   
9.               If Application.WorksheetFunction.IsNumber(xunhuan_cell) = True Then
   
10.                       If 1 * xunhuan_cell < 1 Then
    
11.                           zuhe = zuhe & "0" & xunhuan_cell
    
12.                       Else
    
13.                           zuhe = zuhe & xunhuan_cell
    
14.                       End If
    
15.                       '最最重要的一个知识：在VBA中，0.x类型的小数结果，返回时会自动去掉前导0，而成为.x结果。
    
16.               Else
    
17.                       zuhe = zuhe & xunhuan_cell
    
18.               End If
    
19.       Next
    
20.       phonetic_and_text = zuhe
    
21. End Function
    

复制代码

版本一：自定义连字符函数版本一：固定行数，列标

1. Option Explicit
   
2. 
   
3. Function phonetic_and_text(hangshu As Long, liebiao_first As String, liebiao_last As String)
   
4. '可以用本代码实现 连字符  函数功能，实现 按照单元格区域 连接
   
5.       Application.Volatile
   
6.       
   
7.       Dim xunhuan_lieshu
   
8.       Dim lieshu_first
   
9.       Dim lieshu_last
   
10.       Dim zuhe
    
11.       
    
12.       '求取列数，起始 列标
    
13.       If Len(UCase(liebiao_first)) = 1 Then lieshu_first = Asc(UCase(UCase(liebiao_first))) - 64 '确认 列表为 字母 A 到 Z
    
14.       If Len(UCase(liebiao_first)) = 2 Then   '确认 列表为 字母 AA 到 ZZ
    
15.              lieshu_first = (Asc(Mid(UCase(UCase(liebiao_first)), 1, 1)) - 64) * 26 + (Asc(Mid(UCase(UCase(liebiao_first)), 2, 1)) - 64) Mod 26 '确认 列表为 字母 AA 到 ZZ
    
16.              If Len(UCase(liebiao_first)) = 2 And ((Asc(Mid(UCase(UCase(liebiao_first)), 2, 1)) - 64) Mod 26) = 0 Then lieshu_first = (Asc(Mid(UCase(UCase(liebiao_first)), 1, 1)) - 64) * 26 + 26
    
17.       End If
    
18.       If Len(UCase(liebiao_first)) = 3 Then   '确认 列表为 字母 AAA 到 XFD
    
19.              lieshu_first = ((Asc(Mid(UCase(UCase(liebiao_first)), 1, 1)) - 65) Mod 26) * 676 + (((Asc(Mid(UCase(UCase(liebiao_first)), 2, 1)) - 64) Mod 26) + 26) * 26 + (Asc(Mid(UCase(UCase(liebiao_first)), 3, 1)) - 64) '确认 列表为 字母 AAA 到 XFD
    
20.              If Len(UCase(liebiao_first)) = 3 And ((Asc(Mid(UCase(UCase(liebiao_first)), 2, 1)) - 64) Mod 26) = 0 Then lieshu_first = ((Asc(Mid(UCase(UCase(liebiao_first)), 1, 1)) - 65) Mod 26) * 676 + (26 + 26) * 26 + (Asc(Mid(UCase(UCase(liebiao_first)), 3, 1)) - 64) '确认 列表为 字母 AAA 到 XFD
    
21.       End If
    
22.       '求取列数，结束 列标
    
23.       If Len(UCase(liebiao_last)) = 1 Then lieshu_last = Asc(UCase(UCase(liebiao_last))) - 64 '确认 列表为 字母 A 到 Z
    
24.       If Len(UCase(liebiao_last)) = 2 Then   '确认 列表为 字母 AA 到 ZZ
    
25.              lieshu_last = (Asc(Mid(UCase(UCase(liebiao_last)), 1, 1)) - 64) * 26 + (Asc(Mid(UCase(UCase(liebiao_last)), 2, 1)) - 64) Mod 26 '确认 列表为 字母 AA 到 ZZ
    
26.              If Len(UCase(liebiao_last)) = 2 And ((Asc(Mid(UCase(UCase(liebiao_last)), 2, 1)) - 64) Mod 26) = 0 Then lieshu_last = (Asc(Mid(UCase(UCase(liebiao_last)), 1, 1)) - 64) * 26 + 26
    
27.       End If
    
28.       If Len(UCase(liebiao_last)) = 3 Then   '确认 列表为 字母 AAA 到 XFD
    
29.              lieshu_last = ((Asc(Mid(UCase(UCase(liebiao_last)), 1, 1)) - 65) Mod 26) * 676 + (((Asc(Mid(UCase(UCase(liebiao_last)), 2, 1)) - 64) Mod 26) + 26) * 26 + (Asc(Mid(UCase(UCase(liebiao_last)), 3, 1)) - 64) '确认 列表为 字母 AAA 到 XFD
    
30.              If Len(UCase(liebiao_last)) = 3 And ((Asc(Mid(UCase(UCase(liebiao_last)), 2, 1)) - 64) Mod 26) = 0 Then lieshu_last = ((Asc(Mid(UCase(UCase(liebiao_last)), 1, 1)) - 65) Mod 26) * 676 + (26 + 26) * 26 + (Asc(Mid(UCase(UCase(liebiao_last)), 3, 1)) - 64) '确认 列表为 字母 AAA 到 XFD
    
31.       End If
    
32. 
    
33.       zuhe = ""
    
34.       
    
35.       For xunhuan_lieshu = lieshu_first To lieshu_last
    
36.               If Cells(hangshu, xunhuan_lieshu) <> "" Then
    
37.                      If Application.WorksheetFunction.IsNumber(Cells(hangshu, xunhuan_lieshu)) = True Then
    
38.                             If 1 * Cells(hangshu, xunhuan_lieshu) < 1 Then
    
39.                                        zuhe = zuhe & "^0" & Cells(hangshu, xunhuan_lieshu)
    
40.                             Else
    
41.                                        zuhe = zuhe & "^" & Cells(hangshu, xunhuan_lieshu)
    
42.                             End If
    
43.                      Else
    
44.                             zuhe = zuhe & "^" & Cells(hangshu, xunhuan_lieshu)
    
45.                      End If
    
46.               Else
    
47.                      zuhe = zuhe
    
48.               
    
49.               End If
    
50.       Next
    
51.       phonetic_and_text = zuhe & "^"
    
52. End Function

复制代码

grf1973

版本2可以简化一下

1. Function phonetic_and_text(quyu As Range)
   
2. '可以用本代码实现 连字符  函数功能，实现 按照单元格区域 连接
   
3.       Application.Volatile
   
4.       Dim x As Range, y$
   
5.       For Each x In quyu
   
6.         y = CStr(x)
   
7.         If IsNumeric(y) And Left(y, 1) = "." Then y = "0" & y
   
8.         phonetic_and_text = phonetic_and_text & y
   
9.       Next
   
10. End Function

复制代码

hgjian

grf1973 发表于 2016-3-1 16:48
版本2可以简化一下

谢谢......................................

grf1973

版本1可以简化一下：

1. Function phonetic_and_text(hangshu As Long, liebiao_first As String, liebiao_last As String)
   
2. '可以用本代码实现 连字符  函数功能，实现 按照单元格区域 连接
   
3.       Application.Volatile
   
4.       Dim x As Range, y$, zuhe$
   
5.       For Each x In Range(Cells(hangshu, liebiao_first), Cells(hangshu, liebiao_last))
   
6.           y = x
   
7.           If Len(y) > 0 Then
   
8.             If IsNumeric(y) And Left(y, 1) = "." Then y = "0" & y
   
9.             zuhe = zuhe & "^" & y
   
10.           End If
    
11.       Next
    
12.       phonetic_and_text = zuhe & "^"
    
13. End Function
    

复制代码

grf1973

原代码中 “.3"会自动改成"0.3"，但"0.3"会自动改成”00.3“，我觉得这是不对的。