Swapnil Supekar's questions

Quero mesclar o valor da célula com "/" se o próximo valor da coluna A estiver em branco. Anexei uma imagem original.

Quero um resultado como esse.

Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long, j As Long
Set ws = ThisWorkbook.Sheets("Ruff")
lastRow = ws.Range("B:B").SpecialCells(xlCellTypeLastCell).Row
i = 1
j = 1

For i = 3 To lastRow
     
 If Not ws.Cells(i + 1, "A").Value = "" Then
            ws.Cells(i, "G").Value = ws.Cells(i, "B").Value
 Else
    j = i
    Do Until Not IsEmpty(ws.Cells(i, 1).Value)
        ws.Cells(j, "G").Value = ws.Cells(i, "B").Value
        ws.Cells(j, "G").Value = ws.Cells(j, "G").Value & "/" & ws.Cells(i + 1, "B").Value
        i = i + 1
    Loop
    
    
 End If
Next i

End Sub   

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