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

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

  •  0
  • Swapnil Supekar  · 技术社区  · 4 月前

    单元格范围从区域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 回复  |  直到 4 月前
        1
  •  1
  •   Tim Williams    4 月前

    例如,这里有一种方法(假设制作没有问题 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    4 月前

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

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