Стереть пустые ячейки в массиве

Question

Я вставляю массив в столбец, проблема в том, что он оставляет некоторые ячейки в столбце пустыми. Как я могу удалить эти ячейки в столбце?

Это то, что у меня есть:

Private Sub Worksheet_Change(ByVal Target As Range) 

    Worksheets("Info").Range("A1").Select 
    Dim i As Integer 
    Dim iLastRow As Long 
    iLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 
    Dim arrmatrix() As String 

    ReDim arrmatrix(1 To iLastRow, 1 To 1) 
    For i = 1 To iLastRow 
    Range("A2").Cells(i, 1).Select 
    If Selection.Offset(0, 11) = "Pi emitida" Then 
    arrmatrix(i, 1) = Range("A2").Cells(i, 1).Value 
    End If 
    Next i 
    Worksheets("Inicio").Range("G4:G1000000").ClearContents 

    Worksheets("Inicio").Range("G4").Resize(UBound(arrmatrix, 1)).Value =  arrmatrix() 

end sub 

Answer 1

Есть несколько проблем с примерами кода.

1. Будем надеяться, что это на листе кода Информация рабочего листа. Вы не должны пытаться сделать .Activate другой рабочий лист из макроса события Worksheet_Change.
2. Непонятно, зачем это нужно в макросе событий Worksheet_Change. As-is, это будет выполняться в любое время, когда значение в любом месте рабочего листа будет добавлено/изменено/удалено. Это звучит как перебор, поскольку только два столбца, которые определяют результат, - это столбцы A и L.
3. ReDim statement можно использовать с Preserve, чтобы развернуть массив, но он может только переназначить последний ранг.

Эта модификация не зависит от выбора или активации листа (листов) перед их обработкой. Аргумент arrmatrix расширяется по мере необходимости, поэтому вы не получаете пустых значений в массиве.

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Range("A:A, L:L")) Is Nothing Then 
     On Error GoTo Fìn 
     Application.EnableEvents = False 
     Dim i As Long, n As Long 
     Dim arrmatrix As Variant 
     ReDim arrmatrix(1 To 1, 1 To 1) 
     For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 
      If Cells(i, 12).Value = "Pi emitida" Then 
       n = n + 1 
       ReDim Preserve arrmatrix(1 To 1, 1 To n) 
       arrmatrix(1, n) = Cells(i, 1).Value 
      End If 
     Next i 
     With Worksheets("Inicio") 
      .Range("G4:G" & Rows.Count).ClearContents 
      .Range("G4").Resize(UBound(arrmatrix, 2), 1) = Application.Transpose(arrmatrix) 
     End With 
    End If 

Fìn: 
    Application.EnableEvents = True 
End Sub 

Это будет выполняться только при добавлении/изменении/удалении значения в столбце A или столбце L.

Так как я расширение и заполнение последнего ранга, я использовал Application.Transpose переориентировать данные, прежде чем я засунул обратно в Inicio листа.