原创：高级查找替换函数，支持通配符，你能看懂吗!

fxqcn

好好学习like这个功能，实在大强大了，可以解决你的问题 下面有个例子，在字符串中查找日期 Function FindStr(strObj As String, strSou As String, strLen As Integer) As String Dim i As Integer For i = 1 To Len(strSou) FindStr = Mid(strSou, i, strLen) If FindStr Like strObj Then Exit Function Next i End Function Sub 测试() dim s as string s="124ewgterh124ewgterh 2003-02-03 wdqwfefwewg" MsgBox FindStr("####-##-##", s, 10) End Sub 这个功能是一个人提出的，好像没人回答，上面s字符中的日期是合法日期都可找到，不信 试试，和位置无关，这是一个版本，更强的我在整理。 Function FindStrPro(strObj As String, strSou As String, strLen As Integer) As String Dim s(3) As String Dim l(3) As Integer s(3) = "*" & strObj & "*" If strSou Like s(3) Then Do s(0) = strSou l(0) = Len(s(0)) l(1) = Int(l(0) * 0.5 + 0.5) l(2) = l(0) - l(1) If l(2) > strLen Then s(1) = Left(s(0), l(1)) s(2) = Right(s(0), l(2)) If s(1) Like s(3) Then strSou = s(1) ElseIf s(2) Like s(3) Then strSou = s(2) Else strSou = Mid(s(0), l(1) - strLen + 1, strLen * 2 - 2) Exit Do End If Else Exit Do End If Loop FindStrPro = FindStr(strObj, strSou, strLen) Else FindStrPro = "" End If End Function 这个功能是用来在大字符串查找用的。字符串是定长的，但你可使用通配符。 Rowen 谢谢你看了这个程序，这程序我想了一晚上，本来想写成多次搜索加定位以及不定长字符串，但太复杂了，现在把这个传上去，主要是抛砖引玉，欢引大家讨论和扩展功能，另我写的大多是原创(用VBA大约8 year,就是零零碎碎，没形成风格)，希望大家好好看看，提出讨论应该有用的，否则我没兴趣整理以前写的东东了，Hi!

[此贴子已经被作者于2003-6-9 22:21:41编辑过]

Rowen

不错, 建议整理成一篇文章发给 KEVIN 放到菜园原创区.

fxqcn

补充功能，加上定位功能 Private Function FindStrPos(strObj As String, ByVal strSou As String, strLen As Integer) As Integer Dim s1 As String Dim s2 As String s1 = strSou s2 = FindStrPro(strObj, strSou, strLen) If s2 <> "" Then FindStrPos = InStr(s1, s2) Else FindStrPos = 0 End If End Function

fxqcn

加上新功能，替换和多次搜索功能，写了一天，累，不知对大家有没有用，主要用于数据分析，可以开发增强Excel查找和替换功能(主要没有模糊查找功能)。 Public Function ReplaceStr(strObj As String, ByVal strSou As String, strReplace As String, strLen As Integer) As String Dim s As String Dim l As Integer ReplaceStr = strSou l = FindStrPos(strObj, strSou, strLen) If l > 0 Then strSou = ReplaceStr s = FindStrPro(strObj, strSou, strLen) ReplaceStr = Replace(ReplaceStr, s, strReplace) End If End Function Public Function FindStrPosEx(strObj As String, strSou As String, strLen As Integer, Optional ByRef iMode As Integer = 1) As Integer Dim s As String Dim l As Integer s = "" For l = 1 To strLen s = s & " " Next l For l = 1 To iMode FindStrPosEx = FindStrPos(strObj, strSou, strLen) strSou = ReplaceStr(strObj, strSou, s, strLen) Next End Function

fxqcn

指定查找第几满足条件字符串，iMode是次数 Private Function FindStrAdv(strObj As String, strSou As String, strLen As Integer, Optional ByRef iMode As Integer = 1) As String Dim l As Integer FindStrAdv = strSou l = FindStrPosEx(strObj, strSou, strLen, iMode) If l > 0 Then FindStrAdv = Mid(FindStrAdv, l, strLen) Else FindStrAdv = "" End If End Function

[此贴子已经被作者于2003-6-8 23:07:13编辑过]

stlhq

Ok! Good

郁闷的拖鞋

请问楼主能不能解释一下FindStrPro的算法？谢谢！

leyeah

晕.....太强啦.  EXCEL用成这样. 服.

skylark

已收藏,感谢共享!支持一下!

wkafei

VBA中“like”查询的使用，好东西