将项目从一个列表框移动到一个范围Excel VBA

我开始使用一些借用的代码，通过单个列数组（ANALYSIS_S1_V1）查看数千个条目，将它解散并排序，然后将它们填充到列表框结果。将项目从一个列表框移动到一个范围Excel VBA

现在，我需要在我的Excel电子表格中的其他工作表中列出集合中的所有项目（按顺序）。

我是VBA和这个论坛的新手，所以希望我没有错过已经存在的答案。我确实发现了一个似乎相似的问题，但我没有足够的经验来将其应用到我正在开发的项目中。以下是我已经发现： How to write a VBA collection to an Excel sheet

我也搜索微软和发现什么看起来像一个解决方案，但我不能让它在我的代码工作（我想它只能在即使提到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

来源

2013-10-25 AdamC

你已经拥有你所有的好东西集合中，这样的好东西复制到一列在另一片，在你的子最底部插入此：

For N = 1 To NoDupes.Count 
    Sheets("SheetNew").Range("B" & N).Value = NoDupes.Item(N) 
Next N

来源

2013-10-25 22:39:59

将项目从一个列表框移动到一个范围Excel VBA

回答

相关问题