ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何用VBA从指定位置提取多个不重复字符的字符串?

如何用VBA从指定位置提取多个不重复字符的字符串?

作者:绿色风 分类: 时间:2022-08-17 浏览:71
楼主
omnw
Q:如何用VBA从指定位置提取多个不重复字符的字符串?
A:以下代码可以实现从指定位置,提取指定多个不重复字符组成的字符串。如果E6中输入的是“零”则程序从随机的位置开始取数,如果指定的字符数量大于字符串中不重复字符的个数,则将所有不重复的字符全部提取出来。
  1. Sub 提取不重复字符()
  2.     Dim Rng As Range
  3.     Dim Str As String
  4.     Dim N As Integer
  5.     Dim i As Integer
  6.     Application.ScreenUpdating = False
  7.     For Each Rng In [c7:c19]
  8.         Str = ""
  9.         If [E6] = 0 Then    '取得开始提取不重复字符的起始位置
  10.             i = Application.WorksheetFunction.RoundDown(VBA.Rnd(1) * Len(Rng.Value), 0) + 1    '从随机位置取数
  11.         ElseIf [E6].Value <= Len(Rng.Value) Then
  12.             i = [E6].Value    '从指定位置开始提取
  13.         Else
  14.             Rng.Offset(0, 1) = "提取字符的位置大于原始数据长度"
  15.             GoTo 1
  16.         End If
  17.         If Len(Rng.Value) >= [D6] Then    '如果提取字符的数量大于文本的长度则退出
  18.             For N = i To Len(Rng.Value) + i - 1    '遍历每一个字符
  19.                 If InStr(Str, Mid(Rng.Value, (N Mod Len(Rng.Value)) + 1, 1)) = 0 Then    '检查当前字符是否包含在已经提取的字符串中
  20.                     Str = Str & Mid(Rng.Value, (N Mod Len(Rng.Value)) + 1, 1)
  21.                     If Len(Str) = [D6] Then    '如果达到指定提取的位数,退出循环
  22.                         Exit For
  23.                     End If
  24.                 End If
  25.             Next N
  26.             Rng.Offset(0, 1) = Str
  27.         Else
  28.             Rng.Offset(0, 1) = "提取字符数大于原始数据长度"
  29.         End If
  30. 1:         Next Rng
  31.     Application.ScreenUpdating = True
  32. End Sub


 

在单元格里提取多个不同字符.rar
2楼
avel
用字典不是更方便么?
3楼
icenotcool



免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap