Функция массива VBA - возвращаемый массив из диапазона без пробелов

Question

Я борюсь с основной проблемой в VBA и буду признателен за помощь. Я хочу, чтобы определить функцию, которая возвращает массив из диапазона без пробелов, как показано ниже:

Так что, когда я вызываю функцию в европейской опционной ячейке, функция должна возвращать массив без каких-либо пробелов , как на правой стороне.

Это код, который я до сих пор:

Function portfolioX(N) 
    Dim MyArray(3) 
    Dim i As Integer 
    counter = 1 
    For i = 1 To N 
     If IsEmpty(i) Then 
      Next i 
     Else 
      portfolio = MyArray 
      MyArray (counter) 
      counter = counter + 1 
      Next i 
     End If 
End Function 

Я новичок в VBA, так что это может быть совершенно неправильно. Благодаря!

Answer 1

Если инструкция и цикл являются блоками кода. Вы не можете чередовать блоки кода.

Function portfolioX(N) 

    For i = 1 To N ' Block 1 starts 
     If IsEmpty(i) Then ' Block 2 starts 
     Next i 'Block 1 can't loop back because Block 2 has't closed 
    Else 
     portfolio = MyArray 
     MyArray (counter) 
     counter = counter + 1 
    Next i 'Block 1 can't loop back because Block 2 has't closed 
    End If ' Block 2 

End Function 

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

For i = 1 to N 

next i 

Далее идет блок If

For i = 1 To N 
    If IsEmpty(i) Then 

    End If 
Next i 

И наконец

Function portfolioX(N) 
    Dim MyArray(3) 
    Dim i As Integer 
    counter = 1 
    For i = 1 To N ' Block 1 Starts 
     If IsEmpty(i) Then Block 2 Starts 
      portfolio = MyArray 
      MyArray (counter) 
      counter = counter + 1 
     End If ' Block 2 Closes 
    Next i 'If the Loop Condition is meet, Block 1 Closes, else i is incremented and the loop starts over 
End Function 

Answer 2

Учитывая то, что вы просите, я написал быстрый суб который будет принимать выделенный диапазон и вставить значения с пустыми ячейками, удаленными в конце строки. Надеюсь, это может дать вам начало тому, что вы надеетесь достичь.

Sub RemoveBlanks() 

Dim OriginalRange As Range, WorkCell As Range, PasteCol As Integer 
Set OriginalRange = Selection.Rows(1) 'Ensures only one row of data is selected 
PasteCol = Range(Cells(OriginalRange.Row, ActiveSheet.UsedRange.Columns.Count + 2).Address).End(xlToLeft) 
For Each WorkCell In OriginalRange 
    If Not IsEmpty(WorkCell) Then 
     Cells(OriginalRange.Row, PasteCol).Value = WorkCell.Value 
     PasteCol = PasteCol + 1 
Next WorkCell 

End Sub 

Answer 3

Основываясь на ваш вопрос и комментарии в этой теме, я понимаю, что вы хотите взять данный диапазон (поставляется в порядке) и печатать все непустые значения в некотором диапазоне, начиная с одной и той же строке в столбце R (18-я колонка).

В комментарии вы указываете диапазоны A1:A13 и A18:A21, но это не соответствует вашему скриншоту. Я предполагаю, что вы имели в виду ряд 1 (или некоторую произвольную строку), столбцы от 1 до 13 и колонн 18 до 21.

Вот решение этой проблемы:

Sub arrayPaster(rng As Range) 
    Dim s() As Variant, r() As Variant, j As Integer 

    ReDim r(1 To 1, 1 To 1) 
    s = rng.Value 
    j = 1 

    For i = 1 To UBound(s, 2) 
     If s(1, i) <> "" Then 
      ReDim Preserve r(1 To 1, 1 To j) 
      r(1, j) = s(1, i) 
      j = j + 1 
     End If 
    Next i 

    Range("R" & rng.Row).Resize(1, UBound(r, 2)).Value = r 
End Sub