1

我得到了一张包含各种数据的表格。在一个列中，我们发现某种项目编号会不时出现。我想创建一个包含每个项目编号的列表。

因此，我考虑创建一个数组，如果现有数组中尚不存在该数字，则将其添加到其中。

最后，数组应显示在表格中

这是我迄今为止提出的：

Sub ChoseNumbers()
' Chosing the Numbers in the AreaDim Arr() As Integer
Dim i As Integer
Dim area As Range

Set area = Columns("N").cells

i = 0
For Each cell In area
    If IsEmpty(cell) Then
        Exit For
    ElseIf i = 0 Then
        ReDim Preserve Arr(i)
        Arr(UBound(Arr)) = cell.Value
        i = i + 1
    ElseIf IsInArray(cell.Value, Arr) = False Then
        ReDim Preserve Arr(i)
        Arr(UBound(Arr)) = cell
        i = i + 1
    End If
Next cell


'Giving the selection out again

For i = 1 To (UBound(Arr))

cells(i, 1).Value = Arr(i)

Next i

End Sub

谢谢你的建议！

4

3 回答 3

7

如果您要遍历一系列单元格并且只是在寻找一种简单有效的方法来为一维数组分配唯一值，我会查看字典对象： http ://www.w3schools.com /asp/asp_ref_dictionary.asp

Set objDic = CreateObject("Scripting.Dictionary")
For Each Cell In Area
    If Not objDic.Exists(Cell.Value) Then
        objDic.Add Cell.Value, Cell.Address
    End If
Next

I = 1
For Each Value In objDic.Keys
    Cells(I,1).Value = Value
    I = I + 1
Next
于 2013-10-28T05:12:43.570 回答
1

添加你也可以把

Activeworkbook.Worksheets("WorksheetName").Range("YourRange") =     
Application.Transpose(ObjDic.keys)
于 2015-04-09T13:48:07.903 回答
0

我已经重写了您的代码以使用该RemoveDuplicates功能

Option Explicit
Sub ChoseNumbers()

Dim WS As Worksheet
Dim area As Range
Dim arr As Variant
Dim i As Long

Const SheetName As String = "Sheet1"
Const FromColumnIndex As Long = 14 'Column N
Const ToColumnIndex As Long = 1 'Column A

Set WS = ThisWorkbook.Worksheets(SheetName)
Set area = WS.Cells(1, FromColumnIndex).Resize( _
    WS.Cells(1, FromColumnIndex).End(xlDown).Row)

'Make Copy
area.Copy
WS.Cells(1, ToColumnIndex).PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Remove Duplicates (from copy)
area.Offset(, ToColumnIndex - FromColumnIndex).RemoveDuplicates Array(1)

'Move to Array
arr = WS.Cells(1, ToColumnIndex).Resize( _
    WS.Cells(1, ToColumnIndex).End(xlDown).Row)

'Print Results
For i = LBound(arr, 1) To UBound(arr, 1)
    Debug.Print arr(i, 1)
Next

End Sub

另外，一个有用的提示......您可以将一个 excel 范围直接添加到一个 vba 数组中，如上面所做的那样，arr = ... 这会输出一个二维数组（例如行 + 列）

此外，利用.End(xlDown)查找列中的最后一个填充单元格

于 2013-10-27T20:37:01.417 回答