VBA将多个范围复制到无阵列循环中 [英] VBA Copy multiple Ranges into Array-no looping

问题描述

我想将数据从分开的范围复制到一个没有loopnig的数组中.以下方法行不通，因为它仅使用rng1中的数据填充数组.有什么建议我可以做到这一点吗?

I want to copy data from separated ranges into an Array without loopnig. The following Approach doesn't work as it only populates the array with data from rng1.Any suggestions how I can do this?

Dim rng1 As Range, rng2 As Range, rng3 As Range, rngMerge As Range
Dim tmpMatrixCPs_CDS() As Variant

Set WS_Ins_Mapping = ThisWorkbook.Worksheets("Instrumente_Mapping")
LastRow = WS_Ins_Mapping.Cells(rows.Count, 2).End(xlUp).Row
Set rng1 = WS_Ins_Mapping.Range(WS_Ins_Mapping.Cells(6, 2), WS_Ins_Mapping.Cells(LastRow, 2))
Set rng2 = WS_Ins_Mapping.Range(WS_Ins_Mapping.Cells(6, 26), WS_Ins_Mapping.Cells(LastRow, 26))
Set rng3 = WS_Ins_Mapping.Range(WS_Ins_Mapping.Cells(6, 36), WS_Ins_Mapping.Cells(LastRow, 36))
Set rngMerge = Union(rng1, rng2, rng3)
tmpMatrixCPs_CDS = WS_Ins_Mapping.Range(rngMerge).Value

非常感谢

推荐答案

如果您希望将不相邻的列传输到数组，那么这是一个可能的选择(

If you are looking to transfer non-neighbouring columns to an array, then this is a possible option (with credit to Mr.Excel forum):

Sub TestMe()

    Dim rng1 As Range: Set rng1 = Range("A2:A10")
    Dim rng2 As Range: Set rng2 = Range("B2:B10")
    Dim rng3 As Range: Set rng3 = Range("C2:D10")
    Dim rngAll As Range: Set rngAll = Union(rng1, rng2, rng3)

    Dim myArr As Variant
    Dim firstRow As Long: firstRow = 1
    Dim lastRow As Long: lastRow = rngAll.Rows.Count

    Dim evalRows As Variant
    evalRows = Application.Evaluate("row(" & firstRow & ":" & lastRow & ")")

    myArr = Application.Index(rngAll, evalRows, Array(1, 3, 4))

    Dim myCol As Long, myRow As Long
    For myCol = LBound(myArr) To UBound(myArr)
        For myRow = LBound(myArr, 2) To UBound(myArr, 2)
            Debug.Print myArr(myCol, myRow)
        Next
    Next

End Sub

上面的代码有2个棘手的部分:

There are 2 tricky parts in the code above:

• 给定范围的第一行应硬编码为1；
• Application.Index(rngAll, evalRows, Array(1, 3, 4))可以手动编写列，也可以将其视为Rng1.Column;

• The first row of a given range should be hardcoded to 1;
• Application.Index(rngAll, evalRows, Array(1, 3, 4)) The columns could be written manually or these can be taken as Rng1.Column;

如果范围之间没有间隙，则可以进行以下操作:

If the ranges are without a gap, then this works:

Sub TestMe()

    Dim rng1 As Range: Set rng1 = Range("A1:A10")
    Dim rng2 As Range: Set rng2 = Range("B1:B10")
    Dim rng3 As Range: Set rng3 = Range("C1:D10")
    Dim rngAll As Range: Set rngAll = Union(rng1, rng2, rng3)

    Dim myArr As Variant
    myArr = Application.Transpose(rngAll)

    Dim myCol As Long, myRow As Long

    For myCol = LBound(myArr) To UBound(myArr)
        For myRow = LBound(myArr, 2) To UBound(myArr, 2)
            Debug.Print myArr(myCol, myRow)
        Next
    Next

End Sub

这篇关于VBA将多个范围复制到无阵列循环中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！