将多个Excel范围保存到二维数组中-并非同时存在 [英] Saving Multiple excel Ranges into a 2 dimensional array - not all at the same

问题描述

我正在编写一个excel宏，该宏本质上分析了一个信息范围(特别是一行)，并且如果存在三重复(一行中有3个或更多相同的名称)，它将范围设置为红色，从而使其脱颖而出.现在，我想做的是每当程序找到一个三重范围时，就将该范围(3行乘8列)保存到一个数组中.我知道如何将单个范围保存到数组中，但是如何添加程序找到的下一个范围(然后再添加下一个范围).程序运行并找到所有三重范围后，我希望它采用该二维数组并将所有找到的数据粘贴到空白表中.

Im writing an excel macro, that essentially analyzes a range of information (one row specifically), and if there are triplicates (3 or more of the same name in a row), it sets the range to red so it stands out. Now what i want to do is every time the program finds a triplicate range, it saves that range (3 rows by 8 columns) to an array. I understand how to save a single range into an array, but how do i add the next range that my program finds (and then the next range, thereafter). After the program runs and finds all triplicate ranges, I want it to take that 2-d array and paste all of the found data into an empty sheet.

    For k = 1 To LastRow - 1

                 '   If (k + 1 <= LastRow) Then

                    If (FunctionArray(k + 1) = FunctionArray(k)) Then
                        count = count + 1

                    ElseIf (count >= 3 And FunctionArray(k + 1) <> FunctionArray(k)) Then
                        StartPoint = k - (count - 2)
                        Range(Cells(StartPoint, 1), Cells(k + 1, 11)).Select
                        With Selection
                            .Font.Bold = True
                            .Font.Color = -16776961
                            .Borders(xlEdgeLeft).LineStyle = xlContinuous
                            .Borders(xlEdgeRight).LineStyle = xlContinuous
                            .Borders(xlEdgeBottom).LineStyle = xlContinuous
                            .Borders(xlEdgeTop).LineStyle = xlContinuous
                        End With



                        count = 1

                    ElseIf (count = 2 And FunctionArray(k + 1) <> FunctionArray(k)) Then
                        count = 1
                    End If


                Next k

如果您在第二条IF语句中查找，我已经成功写出了找到所需范围的逻辑.我只需要将在二维数组中找到的信息保存起来，然后继续添加找到的范围即可.感谢您的任何帮助.

If you look in the second IF statement, i already successfully wrote out the logic to find the desired range. i just need to save that information i find in a 2-d array and then continue to add the found ranges thereafter. Thank you for any help.

推荐答案

如果我没看错，您想采用可变数量的矩形范围，并最终将所有值收集到一个二维数组中，该数组可以您可以粘贴到工作表中.一种方法是创建范围的集合，然后将它们提供给一个函数，该函数会将它们收集到单个数组中.以下代码显示了一个可能的功能以及一个测试子实例，以说明其功能.要进行测试-将值放在"A1:C2"和"B4:C6"范围内，然后运行测试子程序:

If I read you right, you want to take a variable number of rectangular ranges and, ultimately, gather all of the values into a single 2-dimensional array that you can paste into a worksheet. One method is to create a collection of ranges, then feed them to a function which will gather them into a single array. The following code shows one possible function as well as a test sub to illustrate what it does. To test is -- put values into ranges "A1:C2" and "B4:C6" and then run the test sub:

Function compactify(ranges As Collection) As Variant
'assumes that ranges is a non-empty collection
'of rectangular ranges
    Dim i As Long, j As Long, m As Long, n As Long
    Dim block As Variant
    Dim r As Range, myRow As Range
    For Each r In ranges
        m = m + r.Rows.Count
        If r.Columns.Count > n Then n = r.Columns.Count
    Next r
    ReDim block(1 To m, 1 To n)
    For Each r In ranges
        For Each myRow In r.Rows
            i = i + 1
            For j = 1 To myRow.Columns.Count
                block(i, j) = myRow.Cells(1, j).Value
            Next j
        Next myRow
    Next r
    compactify = block
End Function

Sub test()
    Dim myRanges As New Collection
    myRanges.Add Range("A1:C2")
    myRanges.Add Range("B4:C6")
    Range("A10:C14").Value = compactify(myRanges)
End Sub

这篇关于将多个Excel范围保存到二维数组中-并非同时存在的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！