在VBA中组合数组

时间:2011-10-01 16:45:43

标签: arrays vba

我有一份去年的客户名单(在A栏),我有一份今年的客户名单(在B栏)。我把这两列中的数据放在数组中(使用下面的代码 - 设置为Option Base 1):

    'Define our variables and array types'
    Sub CustomerArray()
       Dim LastArray() As String
       Dim CurrentArray() As String
       Dim BothArray() As String
       Dim LR As Long
       Dim i As Integer

    'Define LastArray which is customers last year'
    LR = Cells(Rows.Count, 1).End(xlUp).Row
    ReDim LastArray(LR - 3)
    With Range("A1")
      For i = 1 To LR - 3
        LastArray(i) = .Offset(i, 0)
      Next i
    End With

    'Define CurrentArray which is customers this year'
    ReDim CurrentArray(LR - 3)
    With Range("B1")
      For i = 1 To LR - 3
        CurrentArray(i) = .Offset(i, 0)
      Next i
    End With


    End Sub

现在我想比较/组合数组,以显示出现在我刚定义的两个数组(去年和今年)中的客户列表。我想与两年出现的客户一起创建第三个数组(我想把它放在我的excel表的D列中)。我对如何编写将比较这两个数组(当前年份和去年)的代码感到困惑。我会使用条件If>声明?每个阵列都按字母顺序列出客户。

我会给你提供任何帮助。

谢谢!

3 个答案:

答案 0 :(得分:3)

你根本不需要乱用数组或循环,保持简单,尝试这样的事情:

Sub HTH()

    With Range("A1", Cells(Rows.Count, "A").End(xlUp)).Offset(, 3)
        .Formula = "=IF(COUNTIF(B:B,A1)>0,A1,"""")"
        .Value = .Value
        .SpecialCells(xlCellTypeBlanks).Delete
    End With

End Sub

答案 1 :(得分:2)

行。我在这里得到了一点点,但这就是你所要求的(你可能需要调整它以满足你的特定需求。要使用这个代码,只需调用Sub“匹配客户”。

您的原始代码建议使用三个数组。 Excel VBA提供了一些机制来执行您所寻求的更易于使用且可能更高效的机制。

我继续把这个过程分解成更多离散的代码块。虽然它看起来像更多的代码,但你会发现每个peice可能更有意义,并且它更易于维护。如果需要,您现在还可以将各个功能重新用于其他操作。

我还将范围和列索引拉出到本地定义的常量中。这样,如果需要更改各种行或列引用,则只需在一个位置更改值。

这不一定是最有效的方法,但很可能没有使用您最初建议的数组那么复杂。

我没有详尽地测试过它,但它在最基本的意义上起作用。如果您有疑问,请告诉我。

希望有所帮助。 。

Option Explicit

'Set your Column indexes as constants, and use the constants in your code.
'This will be much more maintainable in the long run:
Private Const LY_CUSTOMER_COLUMN As Integer = 1
Private Const CY_CUSTOMER_COLUMN As Integer = 2
Private Const MATCHED_CUSTOMER_COLUMN As Integer = 4
Private Const OUTPUT_TARGET As String = "D1"
Private Const LAST_ROW_OFFSET As Integer = -3


'A Function which returns the list of customers from last year
'as a Range object:
Function CustomersLastYear() As Range
    Dim LastCell As Range

    'Find the last cell in the column:
    Set LastCell = Cells(Rows.Count, LY_CUSTOMER_COLUMN).End(xlUp)

    'Return the range of cells containing last year's customers:
    Set CustomersLastYear = Range(Cells(1, LY_CUSTOMER_COLUMN), LastCell)

End Function


'A Function which returns the list of customers from this year
'as a Range object:
Function CustomersThisYear() As Range
    Dim LastCell As Range

    'Find the last cell in the column:
    Set LastCell = Cells(Rows.Count, CY_CUSTOMER_COLUMN).End(xlUp)

    'Return the range of cells containing this year's customers:
    Set CustomersThisYear = Range(Cells(1, CY_CUSTOMER_COLUMN), LastCell)

End Function


'A function which returns a range object representing the
'current list of matched customers (Mostly so you can clear it
'before re-populating it with a new set of matches):
Function CurrentMatchedCustomersRange() As Range
    Dim LastCell As Range

    'Find the last cell in the column:
    Set LastCell = Cells(Rows.Count, MATCHED_CUSTOMER_COLUMN).End(xlUp)

    'Return the range of cells containing currently matched customers:
    Set CurrentMatchedCustomersRange = Range(Cells(1, MATCHED_CUSTOMER_COLUMN), LastCell)

End Function


'A Function which performs a comparison between two ranges
'and returns a Collection containing the matching cells:
Function MatchedCustomers(ByVal LastYearCustomers As Range, ByVal ThisYearCustomers As Range) As Collection
    Dim output As Collection

    'A variable to iterate over a collection of cell ranges:
    Dim CustomerCell As Range

    'Initialize the collection object:
    Set output = New Collection

    'Iterate over the collection of cells containing last year's customers:
    For Each CustomerCell In LastYearCustomers.Cells
        Dim MatchedCustomer As Range

        'Set the variable to reference the current cell object:
        Set MatchedCustomer = ThisYearCustomers.Find(CustomerCell.Text)

        'Test for a Match:
        If Not MatchedCustomer Is Nothing Then

            'If found, add to the output collection:
            output.Add MatchedCustomer
        End If

        'Kill the iterator variable for the next iteration:
        Set MatchedCustomer = Nothing
    Next

    'Return a collection of the matches found:
    Set MatchedCustomers = output

End Function


Sub MatchCustomers()
    Dim LastYearCustomers As Range
    Dim ThisYearCustomers As Range
    Dim MatchedCustomers As Collection
    Dim MatchedCustomer As Range

    'Clear out the destination column using the local function:
    Set MatchedCustomer = Me.CurrentMatchedCustomersRange
    MatchedCustomer.Clear
    Set MatchedCustomer = Nothing

    'Use local functions to retrieve ranges:
    Set LastYearCustomers = Me.CustomersLastYear
    Set ThisYearCustomers = Me.CustomersThisYear

    'Use local function to preform the matching operation and return a collection
    'of cell ranges representing matched customers. Pass the ranges of last year and this year
    'customers in as Arguments:
    Set MatchedCustomers = Me.MatchedCustomers(LastYearCustomers, ThisYearCustomers)


    Dim Destination As Range

    'Use the local constant to set the initial output target cell:
    Set Destination = Range(OUTPUT_TARGET)

    'Itereate over the collection and paste the matches into the output cell:
    For Each MatchedCustomer In MatchedCustomers
        MatchedCustomer.Copy Destination

        'Increment the output row index after each paste operation:
        Set Destination = Destination.Offset(1)
    Next

End Sub

答案 2 :(得分:0)

如果你想使用循环来比较两个数组,可能是因为你已经将所有数据都集成到数组中以便更快地计算而不是与电子表格范围对象进行交互,或者你需要比较来自两个数组检查条目是否匹配,因此无法使用.find语句,这就是你需要的:

- 两个循环,一个嵌套在另一个

- 三个计数器,每个阵列一个

-One"退出循环","退出"," GoTo foundmatch"或类似的退出内循环的方式

-A" Redim Preserve"结果数组

-An"如果"声明

- 最后,在一行中,将两个数组中出现的名称分配给结果数组

这就是将它简单地写成循环所需的一切 - 但是没有提供最快或最好的方法(Redim Preserve不是最好的......)。但是从这个列表中构造它应该很容易:if语句应该是一般用法的x = y类型,或者如果你真的确定在内部循环中循环的列表确实按字母顺序排序,则x> y