将多个不相邻的列复制到数组 [英] Copy Multiple Non-Adjacent Columns To Array

问题描述

我正在尝试将多个不相邻（不连续）的excel列复制到一个数组中，但是它不起作用。下面是我尝试过的方法...

I'm trying to copy multiple non-adjacent (non-contiguous) excel columns to an array but it's not working. Below is what I've tried...

    Public Function Test()    
        Dim sh As Worksheet: Set sh = Application.Sheets("MyWorksheet")
        Dim lr As Long: lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).row
        Dim r1 As Range: Set r1 = sh.Range("A1:A" & lr)
        Dim r2 As Range: Set r2 = sh.Range("C1:C" & lr)
        Dim rAll As Range: Set rAll = Union(r1, r2)
        'Dim arr() As Variant: arr = Application.Transpose(rAll) <-- Throws Type mismatch error
        'Dim arr As Variant: arr = Application.Transpose(rAll) <-- arr Value = Error 2015
        Dim arr() As Variant: arr = rAll.Value2 ' <-- Only the first column (col A) is loaded.
    End Function

任何帮助将不胜感激！

推荐答案

谢谢PEH，
很好的解释使我想到了以下解决方案：

Thank you PEH, Great explanation which led me to the following solution:

    Function Test()
       Dim sh as Worksheet : set sh = Sheets("MySheet")
       Dim lr as Long : lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).row
       Dim arr () as Variant
       Dim idx as Long

       ' Delete unwanted columns to ensure contiguous columns...
       sh.Columns("B:B").Delete

       ' Load Array
       arr = Sheet("MySheet").Range("A1:B" & lr).value2

       ' This allows speedy index finds... Note, index(arr, startrow, keycol) 
       ' Will need to use "On Error" to handle key not being found
       idx = WorksheetFunction.match("MyKey", WorksheetFunction.Index(arr, 0, 2), 0)

       ' And then fast processing through the array
       For idx = idx to lr
          if (arr(idx, 2) <> "MyKey") then exit for
          ' do some processing...
       Next idx
   End Function

再次感谢您！

这篇关于将多个不相邻的列复制到数组的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！