Excel编写自定义函数FINDX,功能与Excel自带的FIND函数完全一样

2025-02-22 23:42:40
推荐回答(4个)
回答1:

经测试通过:
----------
新建一个模块1,代码:
Option Explicit
Option Private Module

Private Declare Function GetSystemDirectory _
Lib "kernel32" Alias "GetSystemDirectoryA" ( _
ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Function iGetSys32Path() As String
'获得文件夹路径
Dim sReturn As String, lReturn As Long
sReturn = Space(255)
lReturn = GetSystemDirectory(sReturn, 255)
sReturn = Left$(sReturn, lReturn)
iGetSys32Path = sReturn
End Function

Public Sub iRegUDF(ByVal FunctionName As String, ByVal Category As String, _
ByVal Description As String, ByVal Args As String, ByVal DescriptionArgs As String)
'FunctionName: 工作表函数名
'Category: 函数类别
'Description: 函数说明
'Args: 参数列表。用","分隔的字符串
'DescriptionArgs: 参数说明。用“"",""”分隔的字符串
'注意:Application.ExecuteExcel4Macro 方法有字数限制,最大254个字符
Dim tmp$
tmp = "REGISTER(""" & iGetSys32Path() & "\user32.dll"",""CharPrevA"",""PPP"",""" _
& FunctionName & """,""" _
& Args & """,1" & ",""" _
& Category & """,,,""" _
& Description & """,""" _
& DescriptionArgs & """)"
If Len(tmp) >= 255 Then
MsgBox "超过了 Application.ExecuteExcel4Macro 方法的字符限制!" _
& vbCrLf & vbCrLf & tmp, vbCritical
Exit Sub
End If
Application.ExecuteExcel4Macro tmp

End Sub

Public Sub iUnregUDF(ByVal FunctionName As String)
With Application
.ExecuteExcel4Macro "UNREGISTER(" & FunctionName & ")"
.ExecuteExcel4Macro "REGISTER(""" & iGetSys32Path() & "\user32.dll""" & _
",""CharPrevA"",""P"",""" & FunctionName & """,,0)"
.ExecuteExcel4Macro "UNREGISTER(" & FunctionName & ")"
End With
End Sub

Sub UnregisterUDF() '删除注册自定义函数
Call iUnregUDF("iFind")
End Sub

Sub RegisterUDF() '注册自定义函数
Call iRegUDF( _
"iFind", _
"文本", _
"自定义的find程序,与系统的find函数相同。", _
"Find_text,Within_text,Start_num", _
"要查找的字符串。用双引号(表示空串)可匹配 Within_text 中的第一个字符,不能使用通配符" & """,""" _
& "要在其中进行搜索的字符串" & """,""" _
& "可选参数。起始搜索位置。如果忽略,Star_num = 1。")
End Sub

Public Function iFind(find_text As String, within_text As String, Optional start_num As Long = 1)
'自定义函数 iFind,功能与系统的 Find 相同。
Application.Volatile
iFind = InStr(start_num, within_text, find_text)
End Function
--------------

在 thisworkbook 中加入下面的代码,用于自动注册:
-------------
Option Explicit

Private Sub Workbook_AddinInstall() '自动安装插件
RegisterUDF
End Sub

Private Sub Workbook_AddinUninstall() '自动卸载插件
UnregisterUDF
End Sub
-----------
然后保存工作薄为加载宏,比如 iFind.XLA ,然后打开一个新工作薄,加载 iFind.XLA ,这时自定义的函数 iFind() 已经在 “文本”函数列表里面了,帮助和说明都有

回答2:

新建一个工作薄,录制一个空宏,添加如下代码:
Function FINDX(find_text As String, within_text As String, start_num As Integer)
'FIND(find_text,within_text,start_num)

Dim i As Integer
Dim j As Integer
If start_nume = 0 Then start_nume = 1
For start_nume = 1 To Len(within_text) - Len(find_text)
If Mid(within_text, i, Len(find_text)) = find_text Then Exit For
Next
If i <> Len(within_text) - Len(find_text) + 1 Then
FINDX = i
Else
FINDX = "#VALUE!"
End If
'
End Function

然后在宏编辑界面按F2,点那个"所有库",选择VBAproject,点下面点模块1,右边找到FINDX,右击选择属性,在弹出点对话框中添加自定义函数描述"返回一个字符串在另一个字符串中出现的起始位置(区分大小写)",保存后关闭宏编辑界面,将工作薄另存为加载宏,即扩展名为"xla”,存在默认路径下,关闭execl.
再新建一个工作薄,新建一个空宏,用如下代码:
Sub dd()
Call gRegisterUDF( _
FunctionName:="FINDX", _
Category:="文本", _
Description:="返回一个字符串在另一个字符串中出现的起始位置(区分大小写)。", _
Args:="find_text, within_text, start_num", _
DescriptionArgs:="""要查找的字符串"",""目标字符串"",""查找的起始位置,默认值为1""")

End Sub
Public Sub gRegisterUDF( _
ByVal FunctionName As String, _
ByVal Category As String, _
ByVal Description As String, _
ByVal Args As String, _
ByVal DescriptionArgs As String)

Application.ExecuteExcel4Macro _
"REGISTER(""" & "C:\windows\system32" & "\user32.dll"",""CharPrevA"",""PPP"",""" _
& FunctionName & """,""" & Args & """,1" _
& ",""" & Category & """,,,""" & Description & """," & DescriptionArgs & ")"
End Sub

Public Sub gUnregisterUDF( _
ByVal FunctionName As String)

With Application
.ExecuteExcel4Macro "UNREGISTER(" & FunctionName & ")"
.ExecuteExcel4Macro "REGISTER(""" & "C:\windows\system32" & "\user32.dll""" & _
",""CharPrevA"",""P"",""" & FunctionName & """,,0)"
.ExecuteExcel4Macro "UNREGISTER(" & FunctionName & ")"
End With
End Sub
保存并运行宏dd,关闭宏编辑器,点击工具,选择加载宏,找到FINDX打钩,保存,退出即可。
这样做了的自定义函数和系统函数功能差不多,但是做不到完全一样。
以上代码经本人测试,你可以HI我要源代码~~

回答3:

Function FINDX(find_text, within_text, start_num)
Dim f_len, w_len, p As Integer

p = 0
w_len = Len(within_text)

Select Case start_num
Case Is <= 0
FINDX = "start_num<0"
Case Is > w_len
FINDX = "start_num>within_text"
Case Else
If find_text = "" Then find_text = Mid(within_text, start_num, 1)
f_len = Len(find_text)

For i = start_num To w_len - f_len + 1
k = Mid(within_text, i, f_len)
If find_text = Mid(within_text, i, f_len) Then p = i
Next i

If p = 0 Then FINDX = "No" Else FINDX = p
End Select
End Function

FIND
FIND 用于查找其他文本字符串 (within_text) 内的文本字符串 (find_text),并从 within_text 的首字符开始返回 find_text 的起始位置编号。也可使用 SEARCH 查找其他文本字符串中的某个文本字符串,但是,FIND 和 SEARCH 不同,FIND 区分大小写并且不允许使用通配符。
语法
FIND(find_text,within_text,start_num)
Find_text 是要查找的文本。
Within_text 是包含要查找文本的文本。
Start_num 指定开始进行查找的字符。within_text 中的首字符是编号为 1 的字符。如果忽略 start_num,则假设其为 1。
提示
使用 start_num 可跳过指定数目的字符。例如,假定使用文本字符串“AYF0093.YoungMensApparel”,如果要查找文本字符串中说明部分的第一个“Y”的编号,则可将 start_num 设置为 8,这样就不会查找文本的序列号部分。FIND 将从第 8 个字符开始查找,而在下一个字符处即可找到 find_text,于是返回编号 9。FIND 总是从 within_text 的起始处返回字符编号,如果 start_num 大于 1,也会对跳过的字符进行计数。
说明
如果 find_text 是空文本 (""),则 FIND 会匹配搜索串中的首字符(即:编号为 start_num 或 1 的字符)。
Find_text 中不能包含通配符。
如果 within_text 中没有 find_text,则 FIND 和 FINDB 返回错误值 #VALUE!。
如果 start_num 不大于 0,则 FIND 和 FINDB 返回错误值 #VALUE!。
如果 start_num 大于 within_text 的长度,则 FIND 和 FINDB 返回错误值 #VALUE!。

回答4:

完全一样就直接用,为什么还要写?