2011-03-21 86 views
0

我有一个范围,我在VBA循环通过:加载只有唯一值的数组

For Lrow = Firstrow To Lastrow Step 1 
     With .Cells(Lrow, "E") 
      If Not IsError(.Value) Then 

      End If 
     End With 
    Next Lrow 

在这一if语句我需要每个值来加载阵列

MB-NMB只有一次-ILA
MB-NMB-ILA
MB-NMB-STP
MB-NMB-STP
MB-NMB-WAS
MB-NMB-WAS
MB-NMB-WAS

所以对于数组我只想MB-NMB-ILA,MB-NMB-STP和MB-NMB-WAS

谁能帮助我,我的大脑ISN”不要在星期一工作!由于

+0

您可以使用字典采取独特的价值观,然后将它们复制回你的阵列(或直接使用字典,你喜欢的方式)。注意这个问题已经回答[这里](http://stackoverflow.com/questions/3017852/vba-get-unique-values-from-array)。 RGDS – 2011-03-21 19:28:39

回答

0

设在单元格A1至A5我有以下的,想唯一值即{A,B,C,d}

 A 
1  "a" 
2  "b" 
3  "c" 
4  "c" 
5  "d" 

后续的代码将有助于实现这一两件组成的数组:

CreateUniqueArray - 从每个细胞获得VAL,如果不是已经在阵列添加到阵列

IsInArray - 效用函数,以检查是否在数组值通过执行简单的循环

我不得不说,这是蛮力方式,并欢迎任何改善...

Sub Test() 
    Dim firstRow As Integer, lastRow As Integer, cnt As Integer, iCell As Integer 
    Dim myArray() 
    cnt = 0 
    firstRow = 1 
    lastRow = 10 

    For iCell = firstRow To lastRow 
     If Not IsInArray(myArray, Cells(iCell, 1)) Then 
      ReDim Preserve myArray(cnt) 
      myArray(cnt) = Cells(iCell, 1) 
      cnt = cnt + 1 
     End If 
    Next iCell 
End Sub 

Function IsInArray(myArray As Variant, val As String) As Boolean 
    Dim i As Integer, found As Boolean 
    found = False 

    If Not Len(Join(myArray)) > 0 Then 
     found = False 
    Else 
     For i = 0 To UBound(myArray) 
      If myArray(i) = val Then 
       found = True 
      End If 
     Next i 
    End If 
    IsInArray = found 
End Function 
1

你可以使用过滤器来测试,如果阵列中存在的东西。

Dim arr As Variant: arr = Array("test1", "test2", "test3") 
If UBound(Filter(arr, "blah")) > -1 Then 
    Debug.Print "it is in the array" 
Else 
    Debug.Print "it's not in the array" 
End If 

你也可以使用一个收集和编写一个子只有独特的项目添加到集合

Dim col As New Collection 
Sub addIfUnique(sAdd As String) 
    Dim bAdd As Boolean: bAdd = True 
    If col.Count > 0 Then 
     Dim iCol As Integer 
     For iCol = 1 To col.Count 
      If LCase(col(iCol)) = LCase(sAdd) Then 
       bAdd = False 
       Exit For 
      End If 
     Next iCol 
    End If 
    If bAdd Then col.Add sAdd 
End Sub 
Private Sub Command1_Click() 
    Dim a As Integer 
    Dim b As Integer 
    For a = 1 To 10 
     addIfUnique "item " & a 
     For b = 1 To 10 
      addIfUnique "item " & b 
     Next b 
    Next a 
    For a = 1 To col.Count 
     Debug.Print col(a) 
    Next a 
End Sub