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

时　间:2012-06-17 13:35:08
作　者:欢乐小爪   ID：20149  城市：杭州
摘　要: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交流群 (群号:54525238) 　　　　　　Access源码网店