根据你的问题补充,看来是不方便以通用的自定义函数来解决了,——需要编写一个专门的小程序:
Sub 清理重复数据()
Dim rnga, rngb
Set dic = CreateObject("scripting.dictionary")
With [a1].CurrentRegion.Offset(0, 1)
rnga = .Value
.ClearContents
rngb = .Value
For i = 1 To UBound(rnga, 1)
m = 0
For j = 1 To UBound(rnga, 2)
If rnga(i, j) <> "" And Not dic.exists(rnga(i, j)) Then
dic.Add rnga(i, j), ""
m = m + 1
rngb(i, m) = rnga(i, j)
End If
Next
Next
.Value = rngb
End With
End Sub
###############以下内容是原回答#########################
你的目的不就是要提取无重复值吗?
我给你一个自定义函数,你可以用它来直接写公式,提取你想要的数据!
Function DISTINCT(ParamArray rng())
'对任意多个可选参数,返回其所有元素不重复值构成的一维数组值。
'参数可为单元格区域、数组或单个值。
Dim rnga As Variant
Dim rngb As Variant
Set dic = CreateObject("scripting.dictionary")
For Each rnga In rng
If IsObject(rnga) Then rnga = rnga.Value
If IsArray(rnga) Then
For Each rngb In rnga
If Not IsEmpty(rngb) Then If Not dic.exists(rngb) Then dic.Add rngb, ""
Next
ElseIf Not IsEmpty(rnga) Then If Not dic.exists(rnga) Then dic.Add rnga, ""
End If
Next
DISTINCT = dic.keys
End Function
使用方法:首先,在EXCEL中,按Ctrl+F11打开VBA编程器,“插入”→“模块”,然后在代码窗口中粘贴以上自定义函数代码,关闭VBA编辑器。最后,在工作表数据区域最末行下边选择一个空单元格,输入公式并下拉(假如你的原始数据区域是A1:D20):
=INDEX(DISTINCT($A$1:$D$20),ROW(A1))
如果你要引用多个方形区域的原始数据,可在函数中以英文逗号分隔,例如:
=INDEX(DISTINCT($A$1:$D$20,$E$3:$J$6),ROW(A1))
Sub 清理重复数据()
Dim rnga, rngb
Set dic = CreateObject("scripting.dictionary")
With [a1].CurrentRegion.Offset(0, 1)
rnga = .Value
.ClearContents
rngb = .Value
For i = 1 To UBound(rnga, 1)
m = 0
For j = 1 To UBound(rnga, 2)
If rnga(i, j) <> "" And Not dic.exists(rnga(i, j)) Then
dic.Add rnga(i, j), ""
m = m + 1
rngb(i, m) = rnga(i, j)
End If
Next
Next
.Value = rngb
End With
End Sub
###############以下内容是原回答#########################
你的目的不就是要提取无重复值吗?
我给你一个自定义函数,你可以用它来直接写公式,提取你想要的数据!
Function DISTINCT(ParamArray rng())
'对任意多个可选参数,返回其所有元素不重复值构成的一维数组值。
'参数可为单元格区域、数组或单个值。
Dim rnga As Variant
Dim rngb As Variant
Set dic = CreateObject("scripting.dictionary")
For Each rnga In rng
If IsObject(rnga) Then rnga = rnga.Value
If IsArray(rnga) Then
For Each rngb In rnga
If Not IsEmpty(rngb) Then If Not dic.exists(rngb) Then dic.Add rngb, ""
Next
ElseIf Not IsEmpty(rnga) Then If Not dic.exists(rnga) Then dic.Add rnga, ""
End If
Next
DISTINCT = dic.keys
End Function
使用方法:首先,在EXCEL中,按Ctrl+F11打开VBA编程器,“插入”→“模块”,然后在代码窗口中粘贴以上自定义函数代码,关闭VBA编辑器。最后,在工作表数据区域最末行下边选择一个空单元格,输入公式并下拉(假如你的原始数据区域是A1:D20):
=INDEX(DISTINCT($A$1:$D$20),ROW(A1))
如果你要引用多个方形区域的原始数据,可在函数中以英文逗号分隔,例如:
=INDEX(DISTINCT($A$1:$D$20,$E$3:$J$6),ROW(A1))