vba数组去除重复数据

可以使用字典对象来去除重复数据，具体实现代码如下：

Sub RemoveDuplicates()
    Dim arr As Variant
    Dim dict As Object
    Dim i As Long
    
    '将数组赋值给变量
    arr = Range("A1:A10").Value
    
    '创建字典对象
    Set dict = CreateObject("Scripting.Dictionary")
    
    '遍历数组，将不重复的数据添加到字典中
    For i = LBound(arr) To UBound(arr)
        If Not dict.exists(arr(i, 1)) Then
            dict.Add arr(i, 1), ""
        End If
    Next i
    
    '将字典中的数据输出到新的数组中
    ReDim arr(1 To dict.Count, 1 To 1)
    i = 1
    For Each key In dict.keys
        arr(i, 1) = key
        i = i + 1
    Next key
    
    '输出结果到新的单元格中
    Range("B1").Resize(dict.Count, 1).Value = arr
End Sub

相关问题

vba数组怎么去除重复值

在VBA（Visual Basic for Applications）中去除数组中的重复值，可以通过编写一个自定义函数来实现，以下是一个简单的例子：

Function RemoveDuplicates(arr() As Variant) As Variant
    Dim tmp As New Collection
    Dim i As Integer
    Dim elem As Variant
    
    On Error Resume Next
    
    For i = LBound(arr) To UBound(arr)
        If IsError(tmp(arr(i))) Then
            tmp.Add arr(i), CStr(arr(i))
        End If
    Next i
    
    ReDim Preserve ret(tmp.Count - 1)
    For Each elem In tmp
        ret(ret.Count) = elem
        ret(ret.Count - 1) = 0
    Next elem
    
    RemoveDuplicates = ret
    Set tmp = Nothing
End Function

这个函数`RemoveDuplicates`接收一个数组作为参数，并返回一个没有重复值的新数组。它使用了VB的`Collection`对象来保证只添加唯一的元素。过程大致如下：

1. 创建一个新的`Collection`对象，用于存储不重复的元素。
2. 遍历输入数组的每个元素，使用`Collection`的`Add`方法添加元素，如果添加失败（即元素已存在），则忽略该元素。
3. 最后，将`Collection`中的元素复制到一个新的数组中，并返回这个数组。

请注意，`Collection`对象在添加元素时，是按照元素的`CStr`转换结果来添加的，这意味着它会将数值型数据视为字符串处理，从而可能会导致数字的比较与预期不符。如果你需要去除的数组是数值型数据，你可能需要对函数进行适当的修改，以确保它能正确处理数值比较。

excel vba 正则 去除重复的单词

Excel VBA (Visual Basic for Applications) 中可以结合正则表达式 (RegEx) 来处理文本数据，去除重复的单词。下面是一个简单的例子：

Sub RemoveDuplicateWords()
    Dim rng As Range
    Dim regex As Object
    Dim match As Match
    Dim wordList As Variant
    
    ' 设置需要操作的范围，例如A1:C10
    Set rng = Selection ' 如果你想从当前选区开始
    
    ' 创建一个正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
    
    ' 定义要去除重复的单词的正则表达式模式，这里假设单词由空格分隔
    regex.Pattern = "\b(\w+)\b"
    
    ' 将字符串分割成数组
    wordList = rng.Value ' 获取单元格内容，转换为字符串数组
    wordList = regex.Execute(UCaseJoin(wordList)) ' 使用大写转换并合并为单个字符串，方便比较
    
    ' 创建新的数组存储去重后的结果
    Dim uniqueWords() As String
    ReDim uniqueWords(LBound(wordList) To UBound(wordList) - LBound(wordList))
    
    ' 去重
    Dim i As Long, j As Long
    For i = 0 To UBound(wordList)
        On Error Resume Next
        j = WorksheetFunction.Index(uniqueWords, WorksheetFunction.Match(wordList(i), uniqueWords, 0))
        If Err.Number <> 0 Then
            ' 如果该单词未在uniqueWords中找到，则添加
            uniqueWords(j) = wordList(i)
        End If
        Err.Clear
    Next i
    
    ' 把去重后的结果写回原范围
    rng.Value = uniqueWords
End Sub

Function UCaseJoin(strings() As String) As String
    UCaseJoin = Join(Application.Transpose(strings), " ")
End Function