VBA提取某列不重复的数据放入数组

发布日期:2024-07-22 01:11    点击次数:186

vba提取某列不重复的数据放入数组,下面举例获取下图excel第1列不重复数据的3种方法:

图片

方法1:检查不重复内容放入数组

Sub 不重复内容放入数组()
maxrow = ActiveSheet.UsedRange.Rows.Count       '当前活动工作表的行长
Dim arr() As Variant      '建立动态数组
iCounter = 0    '数组的待用下标
  aa = "#" '第一种特殊字符,注意必须是数组中没有的字符
For Row = 1 To maxrow
    element = Cells(Row, 1)  '获取当前行的元素
    mergestring = aa & Join(arr, aa) & aa '合并数组成字符串
    If InStr(mergestring, aa & element & aa) = 0 Then '检查当前元素是否在数组中存在,不存在则将该元素放入数组
        ReDim Preserve arr(iCounter)       '重新定义动态数组大小
        arr(iCounter) = element       '给数组添加该元素
        iCounter = iCounter + 1
    End If
Next
MsgBox Join(arr, ",")   '用“,”串联数组所有元素查看结果
End Sub

以上代码的原理是通过遍历列内容,检查到数组中没有该列内容则放入数组中。注意特殊符号“#”的作用是在检测元素是否在数组中时作标记区分,所以其必须是数组元素中没有的字符(原理详见我的文章【VBA判断元素是否在数组中】)

方法2:利用字典去重

Sub 利用字典去重数组()
Set dict = CreateObject("scripting.dictionary")    '创建字典
maxrow = ActiveSheet.UsedRange.Rows.Count       '当前活动工作表的行长
For Row = 1 To maxrow
    Key = Cells(Row, 1)
    dict(Key) = ""  '数据放入字典(在遇到相同的键赋值时,不会新增键,而是替换原来的键对应的值)
Next
arr = dict.Keys()  '将字典的所有键放入数组
MsgBox Join(arr, ",")    '用“,”串联数组所有元素查看结果
End Sub

以上代码是利用字典中的键值不会重复的原理,遍历列内容作为键值放入字典【使用d("x") = ""没有x键会增加,已有x键会替换】,实现去重的效果

方法3:使用Filter函数去重

Sub Filter函数去重数组()
maxrow = ActiveSheet.UsedRange.Rows.Count       '当前活动工作表的行长
arr1 = WorksheetFunction.Transpose(Range(Cells(1, 1), Cells(maxrow, 1)))          '单元格区域放入“待去重”数组
Dim arr2() As Variant      '建立动态数组,作为去重后数据存放的数组
iCounter = 0    '“去重数组”的待用下标

aa = "@" '第一种特殊字符
bb = "#" '第二种特殊字符

arr1 = Split(bb & Join(arr1, bb & aa & bb) & bb, aa)    '给“待去重数组”数组里所有元素前后添加“#”
Do
    element = arr1(0)     '获取“待去重数组”里的第一个元素
    If element <> bb & bb Then    '如果数组元素不为空时,则放入“去重数组”数组
        ReDim Preserve arr2(iCounter)       '重新定义动态数组大小
        arr2(iCounter) = Replace(element, bb, "") '给“去重数组”添加该元素(同时剔除元素中的“#”)
        iCounter = iCounter + 1
    End If
    arr1 = VBA.Filter(arr1, element, False)    '“待去重数组”剔除所有element元素
Loop While Join(arr1, "") <> ""   '当“待去重数组数组”为空时退出循环

MsgBox Join(arr2, ",")   '用“,”串联数组所有元素查看结果
End Sub

以上代码的原理是将原数组里的一个元素放入新数组,之后用Filter函数将原数组里的相同名称元素剔除,再提取下一个元素再剔除,循环重复直至原数组为空,这样得到的新数组就是剔除重复值后的数组。

需要注意的是,原数组在进行获取元素放入新数组前,要先对所有数组元素进行前后加特殊符号“保护”,原因是Filter函数的筛选是模糊匹配,想要精确匹配就要对数组元素预处理(方法解析详见我的文章【VBA用Filter精确匹配筛选或剔除数组元素】),注意选择的两种特殊字符必须是在数组元素中没有出现的符号。

第三种方法虽然代码复杂些,但是速度会比前两种快,因为它不需要遍历所有列内容,所以适合在数据非常多的时候使用。

以上内容对您有帮助可以分享或转藏,避免以后找不到。想要了解更多VBA相关知识,欢迎到http://moqingyan.360doc.com我的个人图书馆查看。

本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报。