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

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：

完全一样就直接用，为什么还要写？

最新问答

余姓,世字辈后面取名宝典

为什么QQ密码明明正确但输入老是提示错误？

我高危8周去北京佑安医院检查艾滋病阴性，医生就说我没事了，为什么会长这个

我是行政人员，老板要我转销售，可是销售管理者人品太差，我不想被他束缚，大家给个意见。。。。谢谢啦！

电视剧艰难爱情，大结局里，郝良写的那首诗的内容是什么