扫描多个范围并将唯一值对存储到数组中

时间:2015-06-30 00:23:01

标签: arrays vba excel-vba excel-2010 excel

我正在尝试扫描两列(一列格式化为文本,另一列是自定义格式;不确定这是否重要,但以防万一)并且我想编写一个VBA片段来实现此目的数组只包含唯一的对。

enter image description here

我希望循环遍历表,以便将表的每个元素与此数组的唯一值进行比较,以便我可以执行某些排序操作。

最终结果应为

ScanArray = Array("Per SA","Per SB", "Per SC", "Per FC", "Mod SC", "Mod SB", "Mod SA", "Mod FC", "SP SA", "SP SB", "SP SC", "SP FC")

...用空格分隔出两个不同的元素

下面我的代码试图将两个范围纳入我的阵列 - 但它没有像我希望的那样工作......

 Option Explicit

 Sub ArrayFill()

 Dim WkSht1 As Worksheet
 Dim ScanArray As Variant
 Dim k As Integer

 Set WkSht1 = Worksheets("Cashflow")
 'the compiler definitely doesn't like this
 ScanArray = WkSht1.Range("C3", Range("D36")).RemoveDuplicates 

 For k = LBound(ScanArray) To UBound(ScanArray)

'Do Until Something
    'If matching function Then
    'MsgBox ScanArray(k)
    'End If
'Loop
Next k

End Sub

1 个答案:

答案 0 :(得分:1)

这应该适合你 -

Option Explicit

Sub ArrayFill()
    'Populates the array in the format as specified by the question
    Dim WkSht1, tmpSht As Worksheet
    Dim ScanArray() As String
    Dim i, iCntr, lRow, n As Long

    Set WkSht1 = Worksheets("Cashflow")
    n = WkSht1.Range("C1" , WkSht1.Range("C1").End(xlDown)).Rows.Count
    ReDim ScanArray(n-1)
    For i = 1 To n
        ScanArray(i-1) = WkSht1.Cells(i,3).Value & " " & WkSht1.Cells(i,4).Value
    Next i

    'Removes duplicate entries from the array
    Set tmpSht = ThisWorkbook.Worksheets.Add
    For iCntr = 0 To UBound(ScanArray)
        tmpSht.Cells(iCntr + 1, 1).Value = ScanArray(iCntr)
    Next
    tmpSht.Columns(1).RemoveDuplicates Columns:=Array(1)
    lRow = tmpSht.Range("A1").End(xlDown).Row
    ReDim ScanArray(lRow-1)
    For iCntr = 0 To UBound(ScanArray)
        ScanArray(iCntr) = tmpSht.Cells(iCntr + 1, 1).Value
    Next
    Application.DisplayAlerts = False
    tmpSht.Delete
    Application.DisplayAlerts = True
End Sub()