用VBA一键拆分字符串中的数字与非数字

一键拆分字符串中的数字与非数字,一分钟拆分10000行都一点压力没有。下面我直接上图上代码。

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)) 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