My两列不重复值 自定义函数-欢乐小爪
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


My两列不重复值 自定义函数

发表时间:2012/6/17 13:35:08 评论(0) 浏览(4384)  评论 | 加入收藏 | 复制
   
摘 要:My两列不重复值 自定义函数
正 文:

 

Function My两列不重复值(行 As Integer, 列 As Integer, 选定区域 As Range)

'xlapp.Volatile

Dim EB, 表格Mc

Set EB = GetObject(, "Excel.application")

EB.ScreenUpdating = False

表格Mc = 选定区域.Worksheet.Name

On Error GoTo 1000

Dim cfd As Object

Dim shuzhuARR() As String

Dim arr As Variant

Set cfd = CreateObject("Scripting.Dictionary")

Dim I%, J%, J2%, r%

arr = EB.Sheets(表格Mc).Range(选定区域.Address)

If UBound(arr, 2) > 2 Then

My两列不重复值 = "你选择大于2列"

End If

For I = LBound(arr) To UBound(arr)

myTEXT = ""

myTEXT = arr(I, 1)

myTEXT = myTEXT & "," & arr(I, 2)

If Not cfd.exists(myTEXT) Then

cfd.Add myTEXT, 1

r = r + 1

ReDim Preserve shuzhuARR(1 To 2, 1 To r) As String

shuzhuARR(1, r) = CStr(arr(I, 1))

shuzhuARR(2, r) = CStr(arr(I, 2))

End If

Next

If 行 > UBound(shuzhuARR, 2) Or 列 > UBound(shuzhuARR, 1) Then

My两列不重复值 = ""

Else

My两列不重复值 = shuzhuARR(列, 行)

End If

1000:

EB.ScreenUpdating = True

Set cfd = Nothing

Set EB = Nothing

End Function


Access软件网交流QQ群(群号:198465573)
 
 相关文章
【Access自定义函数】当前月第一个工作日的示例,当前月最后一个...  【红尘如烟  2013/1/19】
【Access自定义函数】字符串中数字相关的几个自定义函数  【网行者  2013/2/6】
【Access自定义函数】不规则提取日期数据的示例  【红尘如烟  2013/2/13】
【Access自定义函数】测算星座,根据日期算出星座,十二星座查询...  【麥田  2013/4/6】
常见问答
技术分类
相关资源
文章搜索
关于作者

欢乐小爪

文章分类

文章存档

友情链接