在book1中无法处理数字和标点”.“放在一个单元格；请大侠们帮助；谢谢

acerqingdao

V0.5D15W2.5S1H50X1.5Q225                                                                                                                                                                                       
用VBA把上面的数字/./字母组合拆分为：   V        0.5        D        15        W        2.5        S        1        H        50        X        1.5        Q        225
数字和“."放在一个单元格，如附件；请大侠指教；多谢！

在本论坛找到”一键拆分字符串中的数字与非数字“但在book1中无法处理数字和标点”.“放在一个单元格；请大侠们帮助；谢谢

acerqingdao

麻烦给点建议；多谢！

liulang0808

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim a%, i%, ii%, nc%
Dim tmp$, k, c%, gs%: gs = 2
a = [a65536].End(xlUp).Row  'A列中的行数
For i = 1 To a  '单元格循环开始
If Cells(i, 1) <> "" Then   '防止A列中内容为空
Set dic = CreateObject("scripting.dictionary")  '创建字典
    nc = Len(Cells(i, 1))   '获取单元格长度
    For ii = 1 To nc    '开始循环单元格中的各个元素
    tmp = Mid(Cells(i, 1), ii, 1)   '设置tmp为单元格中每个元素
    dic.Add ii, tmp '将每个元素剥离后加入字典中
    Next ii
k = dic.items   '设置k为字典内容
tmp = k(0)  '重新设置tmp值，为字典中第一个内容
For c = 1 To dic.Count - 1  '循环字典中内容,因已设置tmp为第一个，故从1开始循环
    If (IsNumeric(tmp) = IsNumeric(k(c))) Or tmp = "." Or k(c) = "." Then  '如果tmp与下一个字典内容的类型相同
        tmp = tmp & k(c)    '将tmp与下一个字典内容结合
    Else    '否则
        Cells(i, gs) = tmp  '这里就表示k(c)与tmp不同，所以将tmp写入单元格中
        gs = gs + 1 '标记要写入的单元格列数，写入完成后加1，方便下次再写入
        tmp = k(c)  'tmp已写入单元格中，故重新赋值tmp为k(c)，因为tmp与k(c)不同了
    End If
If c = dic.Count - 1 Then Cells(i, gs) = tmp    '因为最后一个值往后没有数据了，所以直接写入单元格
Next c  '返回字典循环
gs = 2  '数据源的行数改变，所以列数重新设置为2，即B列
Set dic = Nothing
End If
Next i '返回单元格循环
Application.ScreenUpdating = True
End Sub

liulang0808

具体见附件，是否满足需求吧

chxw68

1. Sub test()
   
2.   Dim reg As New RegExp
   
3.   Dim arr(1 To 100)
   
4.   With reg
   
5.     .Global = True
   
6.     .Pattern = "([A-Z])([0-9.]+)"
   
7.   End With
   
8.   With Worksheets("1")
   
9.     Set mh = reg.Execute(Range("d23"))
   
10.     m = 1
    
11.     For i = 0 To mh.Count - 1
    
12.       arr(m) = mh(i).SubMatches(0)
    
13.       arr(m + 1) = mh(i).SubMatches(1)
    
14.       m = m + 2
    
15.     Next
    
16.     .Range("n24").Resize(1, UBound(arr)) = arr
    
17.   End With
    
18. End Sub
    

复制代码

chxw68

参见附件。

acerqingdao

chxw68 发表于 2014-12-27 09:33
参见附件。

非常感谢chxw68帮助解决了这个问题；我们现在使用的SAP系统都需要2-7-5格式标准才能输入（**-*******-*****）；你的代码解决了这个问题，太牛了；
同时感谢liulang0808d的热心帮助；你的代码注释对我这个初学者帮助很大，再次感谢；