|
- Sub 取唯一值()
- Dim arr, arrResult()
- Dim i As Long, lRecord As Long, j As Long
- Dim strKey As String
-
- '读取单元格数据到数级
- arr = Range("a1").CurrentRegion
- '定义结果数组,和源数组大小相同
- ReDim arrResult(1 To UBound(arr), 1 To UBound(arr, 2))
-
- '字典对象
- Dim objDic As Object
- Set objDic = CreateObject("scripting.dictionary")
-
- '行循环
- For i = LBound(arr) To UBound(arr)
- Select Case True
- '过滤内容非空的情况
- Case Len(arr(i, 3)) = 0 'Len(arr(i, 1)) = 0 Or Len(arr(i, 2)) = 0 Or
- Case Else
- '字典的关键字 省#市#县
- strKey = arr(i, 1) & "#" & arr(i, 2) & "#" & arr(i, 3)
- '如果不存在指定的关键字,则把该行内容写入结果数组
- If Not objDic.exists(strKey) Then
- '在字典内登记新的关键字,避免重复
- objDic(strKey) = ""
- '结果数组记录数自加1
- lRecord = lRecord + 1
- 通过列循环把数据写入结果数组
- For j = LBound(arr, 2) To UBound(arr, 2)
- arrResult(lRecord, j) = arr(i, j)
- Next
- End If
- End Select
- Next
-
- '判断结果数组的个数,避免空数组
- If lRecord > 0 Then
- Range("n1").Resize(lRecord, UBound(arr, 2)).Value = arrResult
- MsgBox "提取不重复完成"
- End If
- '释放字典
- Set objDic = Nothing
- End Sub
复制代码 |
评分
-
查看全部评分
|