代码之家 › 专栏 › 技术社区 › Swapnil Supekar

将二维阵列转换为一维阵列,并将一维阵列粘贴到另一张图纸上

vba excel arrays

0

Swapnil Supekar · 技术社区 · 1 年前

单元格范围从区域Sheet1.range(“A2”)开始,包含公式。如果没有按照公式提取任何数据,则“No DATA”字符串是常量&;我不希望它在从二维阵列传输时包含在一维阵列中。完成1-D数组后,我想将1-D数组粘贴到“B:2”单元格中的“Result”表中;下来。我尝试过在线解决方案。但数组对我来说越来越复杂。新代码也很好。我从不同的来源收集了以下代码。

Sub TwoD_ArrayTo_1D_Array()
    
    Dim rg As Range
    'First row is always blank, so started with cell A2 & range contains formula
    Sheet1.Range("A2").Select
    Set rg = Sheet1.Range("A2").CurrentRegion
    
    Dim arr As Variant, arr1D() As Variant
    arr = rg.Value
    
    Dim i As Long, j As Long, k As Long, rows As Long, totalrows As Long
    
    totalrows = (rg.rows.Count - 1) * (rg.Columns.Count)
    k = 1

    ReDim arr1D(1)
    
    'Convert 2D to 1D array
    For i = i To (rg.rows.Count - 1)
        For j = 1 To rg.Columns.Count
            
            If arr(i, j).Value = "No DATA" Then 'dont want to copy cell if it contains "No DATA"
                GoTo Next_Row
            Else
                arr1D(k) = arr(i, j)
                k = k + 1
                ReDim Preserve arr1D(k)

            End If
            
Next_Row: Next j

    Next i
    

    'Pasting array values in "Result" Sheet
    Dim iRw As Integer
    For iRw = LBound(arr1D) To UBound(arr1D)

      Result.Cells(iRw, 2).Value = arr1D(iRw, 1)
   Next iRw
   
End Sub

2 回复 | 直到 1 年前

1

Tim Williams 1 年前

例如,这里有一种方法(假设制作没有问题 arr2 2D阵列):

Sub TwoD_ArrayTo_1D_Array()
    
    Dim rg As Range, arr As Variant, arr2, v
    Dim nr As Long, nc As Long, r As Long, c As Long, i As Long
    
    Set rg = Sheet1.Range("A2").CurrentRegion
    
    arr = rg.Value           'assumes >1 cell...
    nr = UBound(arr, 1)      '2D array size...
    nc = UBound(arr, 2)
    ReDim arr2(1 To nr * nc, 1 To 1) 'max possible size needed
    i = 0
    
    'loop `arr` and fill `arr2`
    For r = 1 To nr
        For c = 1 To nc
            If arr(r, c) <> "No DATA" Then
                i = i + 1
                arr2(i, 1) = arr(r, c)
            End If
        Next c
    Next r
    
    'using Resize() only fills the needed range
    Sheet1.Range("H2").Resize(i).Value = arr2
    
End Sub

2

0

Michal 1 年前

你可以用一些VBA代码来实现,但只需使用公式就更简单了:

=LET(
    rows,COUNTA(A:A),
    input,INDIRECT("A1:B"&rows),
    oneD,TOCOL(input),
    FILTER(oneD,oneD<>"No data"))