从二维数组中删除重复项并在 VBA 中更新它答案

【问题标题】：Removing Duplicates from 2d array and updating it in VBA从二维数组中删除重复项并在 VBA 中更新它
【发布时间】：2017-09-01 07:06:27
【问题描述】：

我有一个二维数组，其中包含如下值：

数组 - JK(K, NC)

“K”存储项目总数 “NC”存储物品

我需要从“NC”中删除重复项并在删除重复项后更新“K”（即总项目）。

4 - 5, 6, 7, 5
6 - 7, 6, 9, 10, 11, 7
4 - 8, 7, 15, 8
9 - 12, 15, 16, 12、17、18、19、20、16
3 - 26、27、263 - 20, 19, 20
6 - 21, 33, 33, 34, 35, 21
8 - 19, 33, 34, 18, 38, 39, 40, 34
5 - 39, 40, 38, 43, 40
6 - 41, 44, 44, 45, 46 , 41
3 - 20, 19, 20
6 - 21, 33, 33, 34, 35, 21
8 - 19, 33, 34, 18, 38, 39, 40, 34

【问题讨论】：

你已经尝试过的代码是什么？字符串中值的顺序是否重要？
VBA, remove duplicates from array的可能重复
@Moosli 这个问题不同，因为它不想删除重复的数组条目，它想从数组中的字符串中删除重复项。
@Luuklag 对我来说，这个问题并不是很明显，它也可能是一个二维数组，具有不同长度的两个第二维

标签： vba excel vb6

【解决方案1】：

这是一个基于来自 @tigeravatar 和 @Jeeped 的条目和代码的解决方案，您可以在 Stack Overflow 上找到这里，非常感谢这些人。

Removing Duplicate values from a string in Visual Basic

和

Multidimensional Arrays with For Loops VBA

Sub Test()
        Dim strArray(8, 1) As String
        Dim newString As String
        strArray(0, 0) = "4"
        strArray(0, 1) = "5 6 7 5"
        strArray(1, 0) = "6"
        strArray(1, 1) = "7 6 9 10 11 7"
        strArray(2, 0) = "4"
        strArray(2, 1) = "8 7 15 8"
        strArray(3, 0) = "9"
        strArray(3, 1) = "12 15 16 12 17 18 19 20 16"
        strArray(4, 0) = "4"
        strArray(4, 1) = "5 6 7 5"
        strArray(5, 0) = "6"
        strArray(5, 1) = "7 6 9 10 11 7"
        strArray(6, 0) = "9"
        strArray(6, 1) = "12 15 16 12 17 18 19 20 16"

        For i = 0 To UBound(strArray, 1)
                newString = DeDupeString(strArray(i, 1), " ")
                strArray(i, 0) = UBound(Split(newString, " ")) + 1
                strArray(i, 1) = newString
        Next i
    End Sub

    Function DeDupeString(ByVal sInput As String, Optional ByVal sDelimiter As String = ",") As String
        Dim varSection As Variant
        Dim sTemp As String
        varSection = Split(sInput, sDelimiter)
        For Each varSection In Split(sInput, sDelimiter)
            If InStr(1, sDelimiter & sTemp & sDelimiter, sDelimiter & varSection & sDelimiter, vbTextCompare) = 0 Then
                sTemp = sTemp & sDelimiter & varSection
            End If
        Next varSection
        DeDupeString = Mid(sTemp, Len(sDelimiter) + 1)
    End Function

【讨论】：

不错的解决方案。如果只有人们自己学会了谷歌;）

【解决方案2】：

你可以使用这样的函数

Function RemoveDupes(strInput As String) As Variant()

'   Uses Microsoft Scripting Runtime referece

Dim arrSplit() As String
Dim lngCounter As Long
Dim dicDupeCheck As New Scripting.dictionary

arrSplit = Split(strInput, Chr(32))

For lngCounter = 0 To UBound(arrSplit) - 1

    If Not dicDupeCheck.Exists(arrSplit(lngCounter)) Then
        dicDupeCheck.Add arrSplit(lngCounter), arrSplit(lngCounter)
    End If

Next lngCounter

RemoveDupes = Array(dicDupeCheck.Count, Join(dicDupeCheck.Items(), " "))

Erase arrSplit

End Function

这将按如下方式使用

RemoveDupes("12 15 16 12 17 18 19 20 16")(0) 将给出计数，RemoveDupes("12 15 16 12 17 18 19 20 16")(1) 将给出非重复输出。

或者将一个数组设置为removedupes并使用它，所以arr=RemoveDupes("12 15 16 12 17 18 19 20 16")然后OriginalArray(x)=arr(0) & " - " & arr(1)

【讨论】：