作者：绿色风
分类：
时间：2022-08-18
浏览：84
楼主
xyf2210 |
Q：如何取文本中间一段？格式形如23。10'43.68"（纬度），得到结果如23。，10'，43.68"，输入到3个列中。
A：- Sub test()
- Dim mc As Object, arr(), i
- With CreateObject("VBScript.RegExp")
- .Global = True
- .Pattern = "\d+(\.\d+)?[。'""]"
- For Each Rng In Range("a1:a" & [a65536].End(3).Row)
- Set mc = .Execute(Rng.Value)
- i = i + 1
- ReDim Preserve arr(1 To 3, 1 To i)
- arr(1, i) = mc(0): arr(2, i) = mc(1): arr(3, i) = mc(2)
- Next
- End With
- Range("b1").Resize(UBound(arr, 2), 3) = Application.Transpose(arr)
- End Sub
自定义函数，弦月加入了容错处理，并且考虑的更充分，谢谢并学习了。
- Option Explicit
- Function chaif(s As String)
- If Not s Like "*#。*#'*#.#*""*" Then MsgBox "输入的数据无非纬度": chaif = "输入的数据无非纬度": Exit Function
- If Val(Split(s, "。")(0)) > 90 Or Val(Split(Split(s, "。")(1), "'")(0)) > 60 Or Val(Split(Split(s, "'")(1), """")(0)) > 60 Then MsgBox "纬度数据无效": chaif = "纬度数据无效": Exit Function
- Dim mc As Object, arr(1 To 3) As String, i&
- With CreateObject("VBScript.RegExp")
- .Global = True
- .Pattern = "\d{1,2}(\.\d+)?[。'""]"
- Set mc = .Execute(s)
- End With
-
- arr(1) = mc(0): arr(2) = mc(1): arr(3) = mc(2)
- chaif = arr
- Set mc = Nothing: Erase arr
- End Function
 test.rar
自定义函数（xmyjk）.rar
|
2楼
liuguansky |
Val(Split(s, "。")(0)) > 90 Or Val(Split(Split(s, "。")(1), "'")(0)) > 60 Or Val(Split(Split(s, "'")(1), """")(0)) > 60
这一段代码都分离出来了，为什么还要用正则了，再进行循环？
"K哥时髦后遗症"
 |
3楼
xmyjk |
前面那段纯属画蛇添足下下
 ，权当手指操吧
花花真厉害，一句话说俩
 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一