Início / coding / Perguntas / 79421871
Accepted
Swapnil Supekar
Asked: 2025-02-08 02:41:40 +0800 CST

Converter matriz 2-D em matriz 1-D e colar matriz 1-D em outra planilha

  • 772

Intervalo de células começando na região Sheet1.Range("A2") com fórmulas. A string "No DATA" é constante se nada for extraído conforme a fórmula e eu não quero que ela seja incluída na matriz 1-D durante a transferência da matriz 2-D. Depois que a matriz 1-D estiver pronta, eu quero colar a matriz 1-D na planilha "Result" na célula "B:2" e para baixo. Eu tentei soluções online para isso. Mas as matrizes estão ficando complicadas para mim. O novo código também está bom. Eu coletei o código abaixo de fontes diferentes.

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
arrays

2 respostas

  1. Best Answer

    Por exemplo, aqui está uma abordagem (assumindo que não há problema em criar arr2uma matriz 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

  2. Você pode fazer isso com algum código VBA, mas é mais simples usar uma fórmula:

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

relate perguntas