0

我从一些借来的代码开始,这些代码通过一个包含数千个条目的单列数组 (ANALYSIS_S1_V1) 进行查看,它对它们进行重复数据删除和排序,然后用结果填充一个列表框。

现在,我需要在我的 excel 电子表格的另一张表上列出集合中的所有项目(按顺序)。

我是 VBA 和这个论坛的新手,所以希望我没有错过已经存在的答案。我确实发现了一个看起来相似的问题,但我没有足够的经验将其应用到我正在从事的项目中。这是我已经找到的内容: 如何将 VBA 集合写入 Excel 工作表

我还搜索了 Microsoft 并找到了看起来像一个解决方案的解决方案,但我无法让它在我的代码中工作(我认为它只适用于更复杂的编程语言,即使提到了 VB): http://msdn .microsoft.com/en-us/library/83h9yskw.aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1

任何帮助将不胜感激。

Sub RemoveDuplicates2()
    Dim AllCells As Range, Cell As Range
    Dim NoDupes As New Collection
    Dim i As Integer, j As Integer
    Dim Swap1, Swap2, Item

'   The items are in a range named ANALYSIS_S1_V1
    Set AllCells = Sheets("Data").Range("ANALYSIS_S1_V1")

'   The next statement ignores the error caused
'   by attempting to add a duplicate key to the collection.
'   The duplicate is not added - which is just what we want!
    On Error Resume Next
    For Each Cell In AllCells
            NoDupes.Add Cell.Value, CStr(Cell.Value)
'       Note: the 2nd argument (key) for the Add method must be a string
    Next Cell

'   Resume normal error handling
    On Error GoTo 0

'   Sort the collection
    For i = 1 To NoDupes.Count - 1
        For j = i + 1 To NoDupes.Count
            If NoDupes(i) > NoDupes(j) Then
                Swap1 = NoDupes(i)
                Swap2 = NoDupes(j)
                NoDupes.Add Swap1, before:=j
                NoDupes.Add Swap2, before:=i
                NoDupes.Remove i + 1
                NoDupes.Remove j + 1
            End If
        Next j
    Next i

    For Each Item In NoDupes
        BasicReportForm1.ReportSubject_Index.AddItem Item
    Next Item

End Sub
4

1 回答 1

0

您已经在集合中拥有了所有好东西,因此要将好东西复制到另一张表的列中,请将其插入到您的子目录的最底部:

For N = 1 To NoDupes.Count
    Sheets("SheetNew").Range("B" & N).Value = NoDupes.Item(N)
Next N
于 2013-10-25T22:39:59.997 回答