诉诸阵列答案

【问题标题】：Resorting Arrays诉诸阵列
【发布时间】：2019-10-23 08:48:22
【问题描述】：

我收到需要以字符串格式输出的数据：

123 - A, B, C
234 - A
345 - B
567 - B, C
789 - C

我得到的数据按字母（A、B 或 C）排序，然后按数字提供给我。所以我有三个动态数组，例如：

ArrayA(1) = 123
ArrayA(2) = 234
ArrayB(1) = 345
ArrayB(2) = 123
ArrayB(3) = 567
ArrayC(1) = 123
ArrayC(2) = 789
ArrayC(3) = 567

请注意，对应于给定数组中特定 3 位数字的索引不一定对应于相同的 3 位数字，例如数组A(1)=123=数组B(2)。

数组的长度是任意的（A、B 或 C 中可以有任意数量的数字）但只有三个数组。

这样可以很容易地输出如下内容：

123 - A
234 - A
345 - B
123 - B
567 - B
123 - C
789 - C
567 - C

但这不是我想要的结果。

我需要这种格式：

123 - A, B, C
234 - A
345 - B
567 - B, C
789 - C

要直接解决这个问题，下面是一些生成“easy”字符串的代码：

Dim ArrayA(2), ArrayB(3), ArrayC(3) As Integer, Output As String
ArrayA(1) = 123
ArrayA(2) = 234
ArrayB(1) = 345
ArrayB(2) = 123
ArrayB(3) = 567
ArrayC(1) = 123
ArrayC(2) = 789
ArrayC(3) = 567

For i=1 to 2
     Output = Output & ArrayA(i) & " - A" & vbNewLine
Next i
For i=1 to 3
     Output = Output & ArrayB(i) & " - B" & vbNewLine
Next i
For i=1 to 3
     Output = Output & ArrayC(i) & " - C" & vbNewLine
Next i

MsgBox(Output)

如上所述，我希望移动格式，使其按三位数字而非字母组织。

我对解决方案的最佳尝试是尝试将数据写入 Excel 工作表，对其进行适当排序，然后将其拉回 VBA，这似乎不必要地难看。例如：

For i=1 to Len(ArrayA)+Len(ArrayB)+Len(ArrayC)
    If i < Len(ArrayA) Then
        Range("A:"&i).Value = ArrayA(i)
        Range("B:"&i).Value = "A,"
    End If
    If i > Len(ArrayA) And i <= Len(ArrayA) + Len(ArrayB) Then
        Range("A:"&i).Value = ArrayB(i)
        Range("B:"&i).Value = Range("B:"&i).Value & "B,"
    End If
    if i >= Len(ArrayA)+Len(ArrayB) Then
        Range("A:"&i).Value = ArrayC(i)
        Range("B:"&i).Value = Range("B:"&i).Value & "C,"
Next i

然后我可以对它进行排序，搜索重复项，并正确组合它们，最后得到正确的输出：

123 - A, B, C
234 - A
345 - B
567 - B, C
789 - C

【问题讨论】：

我很困惑：你是从一个字符串（如你的开场白中提到的）还是一堆数组（如你的第三句中提到的）开始？您的代码似乎也只是生成 3 个数组。你在哪里尝试达到预期的结果？
我很抱歉。我从一堆数组开始；我最初生成了输出字符串作为最终结果，但现在我需要返回并重写格式。我会澄清的。至于我的尝试，我已经编写了一些非常严厉的尝试，将值写入 Excel 表并整理出重复项，但我认为它没有价值。我也会把它包括在内。'
请注意：Dim ArrayA(2), ArrayB(3), ArrayC(3) As Integer 与 Dim ArrayA(2) As Variant, ArrayB(3) As Variant, ArrayC(3) As Integer 相同。 ArrayA(2) 也等同于 ArrayA(0 to 2)，除非使用 Option Base 1
你在这个问题上付出了很大的努力，但是一张关于它的外观和你期望结果如何的图片总是有帮助的。我仍在努力了解您想要实现的目标...您已经提到：but this is NOT my desired result.，并展示了不是...如果展示desired result 将是很好的。
期望的结果是列表：123 - A, B, C 234 - A 345 - B 567 - B, C 789 - C 我将在我的主要帖子中澄清这一点。谢谢你。也感谢您提供 Dim 信息。

标签： arrays excel vba string

【解决方案1】：

尝试以下方法：

Sub PopulateFromArrays()

Call WriteArray(ArrayA, "A")
Call WriteArray(ArrayB, "B")
Call WriteArray(ArrayC, "C")

End Sub


Function WriteArray(MyArray, MyString)

i = 2
For j = LBound(MyArray) To UBound(MyArray)
    ValueFound = False
    k = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To k
        If Range("A" & i).Value = MyArray(j) Then
            Range("B" & i).Value = Range("B" & i).Value & ", " & MyString
            ValueFound = True
            Exit For
        End If
    Next i
    If ValueFound = False Then
        Range("A" & k + 1).Value = MyArray(j)
        Range("B" & k + 1).Value = MyString
    End If
Next j

End Function

仅供参考，我在数组中填充了以下内容：

ArrayA = Array(123, 456, 789)
ArrayB = Array(123, 567, 912)
ArrayC = Array(456, 789, 567)

结果是：

【讨论】：

【解决方案2】：

似乎是一个很好的字典用例：

ArrayA(1) = 123
ArrayA(2) = 234
ArrayB(1) = 345
ArrayB(2) = 123
ArrayB(3) = 567
ArrayC(1) = 123
ArrayC(2) = 789
ArrayC(3) = 567

'...

Dim e, dictArrays, dictOut, k

Set dictArrays = Createobject("scripting.dictionary")
Set dictOut = Createobject("scripting.dictionary")

dictArrays.Add "A", ArrayA
dictArrays.Add "B", ArrayB
dictArrays.Add "C", ArrayC

For Each k in dictArrays.Keys
    For Each e in dictArrays(k)
        If dictOut.Exists(e) then
           dictOut(e) = dictOut(e) & "," & k  
        Else
           dictOut.Add e, k
        End If
    Next e
Next k

'output the result
For Each k in dictOut.Keys
    Debug.Print k, dictOut(k)
Next k

【讨论】：