繁体   English   中英

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

[英]Scan through multiple ranges and store unique value pairs into an array

我试图扫描两列(其中一列被格式化为文本,另一列为自定义格式;不确定是否重要,但以防万一),我想编写一段VBA以使该数组仅包含唯一对。

在此处输入图片说明

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

最终结果应该是

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

这应该为您工作-

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()

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM