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循环

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

VBA阵列功能 - 从无空格的范围返回数组

3 个答案: