Excel VBA，將2組數據合並成一個數組，去掉空白行

Question

我一直使用 stackoverflow 作為 VBA 的一個很好的參考工具。

我有 2、2 列數據集，如下所示。

我的目標是讓用戶在這 2 列中輸入數據，使用該信息創建一個 2 列數組，並從該數組中刪除空白行，然后創建一個下拉列表，其中包含組合的第一列中的信息大批。 第二列將用於電壓參考。 （header 不是陣列的一部分。）

我所做的是首先創建 2 個 arrays，然后將它們組合起來。 我不確定這是否是最好的方法，我需要一些可以快速工作的東西，我不確定如何正確刪除行。 代碼如下：

Sub test1()
    Dim CombinedArray As Variant
    Dim SWGRArray As Variant
    Dim MCCArray As Variant 
    SWGRArray = Sheets("Worksheet").Range(Cells(3, 8), Cells(19, 9)).value
    MCCArray = Sheets("Worksheet").Range(Cells(3, 10), Cells(19, 11)).value
    CombinedArray = MergeArrays(SWGRArray, MCCArray)
End Sub
Public Function MergeArrays(ParamArray Arrays() As Variant) As Variant
' merges multiple arrays into a single array.
' ParamArray is an array listing other arrays
' Thanks to 'Tom' via https://stackoverflow.com/questions/46051448/excel-vba-joining-two-arrays
    Dim i As Long, J As Long, cnter As Long, UBoundArr As Long, OldUBoundArray As Long
    Dim arr() As Variant
    For J = LBound(Arrays) To UBound(Arrays)
        UBoundArr = UBoundArr + UBound(Arrays(J), 1)
    Next J
    ReDim arr(1 To UBoundArr, 1 To 1)
    For J = LBound(Arrays) To UBound(Arrays)
        For i = LBound(Arrays(J)) To UBound(Arrays(J))
            arr(i + OldUBoundArray, 1) = Arrays(J)(i, 1)
        Next i
        OldUBoundArray = OldUBoundArray + UBound(Arrays(J), 1)
    Next J
    MergeArrays = arr
End Function

Answer 1

堆棧 Arrays

我正要在 16 號發這個帖子，就在我眼前，帖子被刪除了。 所以很抱歉沒有評論，這是很久以前的事了。

Option Explicit

Function getStackedArrays(ByVal FirstIndex As Long, _
                            ParamArray Arrays() As Variant) _
                As Variant
    ' Define Lower-Upper Array.
    Dim UB As Long: UB = UBound(Arrays)
    Dim LU As Variant: ReDim LU(3)
    Dim lub As Variant
    Dim i As Long
    For i = 0 To 3: ReDim lub(0 To UB): LU(i) = lub: Next i
    
    ' Populate Lower-Upper Array and calculate dimensions of Result Array.
    Dim uCount As Long, uCurr As Long
    Dim lMax As Long, lCurr As Long
    For i = 0 To UB
        If IsArray(Arrays(i)) Then
            GoSub calcIsArray
        Else
            GoSub calcNotArray
        End If
        GoSub countnMax
    Next i
    If lMax = 0 Or uCount = 0 Then Exit Function
    
    ' Define Result Array.
    Dim UB1 As Long: UB1 = FirstIndex + uCount - 1
    Dim UB2 As Long: UB2 = FirstIndex + lMax - 1
    Dim Result As Variant: ReDim Result(FirstIndex To UB1, FirstIndex To UB2)
    
    ' Populate Result Array.
    Dim k As Long, l As Long, m As Long, n As Long
    m = FirstIndex
    For i = 0 To UB
        If IsArray(Arrays(i)) Then
            GoSub writeResult
        End If
    Next i
                        
    ' Write Result Array to Function Result.
    getStackedArrays = Result

Exit Function

' Subroutines
calcIsArray:
    If LBound(Arrays(i)) <= UBound(Arrays(i)) Then
        LU(0)(i) = LBound(Arrays(i)): LU(1)(i) = UBound(Arrays(i))
        On Error Resume Next
        LU(3)(i) = LBound(Arrays(i), 2): LU(3)(i) = UBound(Arrays(i), 2)
        On Error GoTo 0
    End If
    Return

calcNotArray:
    If Not IsEmpty(Arrays(i)) Then
        ReDim lub(0): lub(0) = Arrays(i): Arrays(i) = lub
        LU(0)(i) = 0: LU(1)(i) = 0
    End If
    Return

countnMax:
    uCurr = LU(1)(i) - LU(0)(i) + 1: uCount = uCount + uCurr
    On Error Resume Next
    lCurr = LU(3)(i) - LU(2)(i) + 1
    If lCurr > lMax Then lMax = lCurr
    On Error GoTo 0
    Return

writeResult:
    If Not IsEmpty(LU(0)(i)) And Not IsEmpty(LU(2)(i)) Then   ' 2D
        For k = LU(0)(i) To LU(1)(i)
            n = FirstIndex
            For l = LU(2)(i) To LU(3)(i)
                Result(m, n) = Arrays(i)(k, l)
                n = n + 1
            Next l
            m = m + 1
        Next k
    Else                          ' 1D
        For k = LU(0)(i) To LU(1)(i)
            Result(m, FirstIndex) = Arrays(i)(k)
            m = m + 1
        Next k
    End If
    Return

End Function