如何把字符串中的特定字号的字符提取出来

cdcpy

字符串有两种字号的字符组成，我想要其中一种字号的字符，如图中的大号字数字串。由于数据很多，不能一一手动删除，帮请求高手帮助。见附件。
这问题在基础应用版块发过,还没解决,有人建议到这里寻求帮助更合适.

白色GG

要用VBA或者函数解决，就要有规律。

看你的贴图，你要的大号数字有什么规律啊？眼拙，看不出来啊。

闪存不足

测试一下附件看符合要求吗?
批量删除字符串中不同字号的字符串.zip (9.37 KB, 下载次数: 49)

2011-10-27 17:33 上传

点击文件名下载附件

1. 
   
2. 
   
3. Sub Test()
   
4.     Dim Nbr As Integer
   
5.     Dim Letter As Integer
   
6.     Dim StartLen As Integer
   
7.     Dim CutLen As Integer
   
8.    
   
9.     For Nbr = 2 To [A65536].End(3).Row
   
10.         With Cells(Nbr, 1)
    
11.              For Letter = 2 To Len(Cells(Nbr, 1))
    
12.                  If .Characters(Start:=Letter, Length:=1).Font.Size = 18 Then
    
13.                     If .Characters(Start:=Letter - 1, Length:=1).Font.Size <> 18 Then StartLen = Letter
    
14.                     If .Characters(Start:=Letter + 1, Length:=1).Font.Size <> 18 Then
    
15.                        CutLen = Letter - StartLen + 1
    
16.                        Exit For
    
17.                     End If
    
18.                  End If
    
19.              Next
    
20.              Cells(Nbr, 2) = Mid(.Value, StartLen, CutLen)
    
21.         End With
    
22.     Next Nbr
    
23. End Sub
    

复制代码

cdcpy

白色GG 发表于 2011-10-27 17:08
要用VBA或者函数解决，就要有规律。

看你的贴图，你要的大号数字有什么规律啊？眼拙，看不出来啊。

我就是想把字号做为规律啊，好象颜色都可以做为一个条件的，我想知道字号是否也可以？

闪存不足

白色GG 发表于 2011-10-27 17:08
要用VBA或者函数解决，就要有规律。

看你的贴图，你要的大号数字有什么规律啊？眼拙，看不出来啊。

好像就是按字体大小吧?

cdcpy

闪存不足 发表于 2011-10-27 17:34
测试一下附件看符合要求吗?

真的好棒啊，十分感谢。还有一个要求不知能否帮忙，像这类数据整张表都是，估计有50000个，该怎么写VBA语句？

cdcpy

闪存不足 发表于 2011-10-27 17:34
测试一下附件看符合要求吗?

经测试，当改变字符位置的时候不行，见图。还有怎么样才能对多例进行操作，现只有针对A列的。

闪存不足

你好, 以你这个问题, 如果数字本身有规律的话, 其实是有更简便的方法可以用的, 比如说正则表达式, 所以字体并不一定是唯一的切入点. 所以我建议你盖一栋新楼提问, 提供尽量多的实际数据, 因为你之前挑出来(或者捏造?)的例子不全面, 这样就限制了解决方式的选择. 还有你想知道的多列操作, 多到什么程度? 想把结果放在哪里? 这些你都要像教幼儿园的小盆友一样事无巨细地做一个阐述.

cdcpy

闪存不足 发表于 2011-10-28 16:11
你好, 以你这个问题, 如果数字本身有规律的话, 其实是有更简便的方法可以用的, 比如说正则表达式, 所以字体 ...

十分感谢你的帮助，我想说明一下，我给出的例子确是真的，不是凭空想出来的，是我正在使用的一家鸟公司做的软件，导出来的数据。我的问题只是取了一部分数据出来，原来数据有20例，数千行，极不规则，唯一的规律是字符串有两种字体组成。

蓝桥玄霜

1. Sub Test()
   
2.     Dim rng As Range, cel As Range
   
3.     Dim r%, Arr1(), aa$, i&
   
4.     Set rng = [a1].CurrentRegion
   
5.     For Each cel In rng
   
6.         For i = 1 To Len(cel)
   
7.             If cel.Characters(i, 1).Font.Size = 18 Then
   
8.                 aa = aa & Mid(cel, i, 1)
   
9.             End If
   
10.         Next
    
11.         If aa <> "" Then
    
12.             r = r + 1
    
13.             ReDim Preserve Arr1(1 To r)
    
14.             Arr1(r) = aa: aa = ""
    
15.         End If
    
16.     Next
    
17.     Columns("Aa:Aa").NumberFormatLocal = "@"
    
18.     [aa1].Resize(r, 1) = Application.Transpose(Arr1)
    
19. End Sub
    

复制代码