VBA 数组函数 - 从没有空格的范围返回数组答案

【问题标题】：VBA Array Function - Return Array from Range without BlanksVBA 数组函数 - 从没有空格的范围返回数组
【发布时间】：2016-10-13 14:12:13
【问题描述】：

我正在努力解决 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 的新手，所以这可能是完全错误的。谢谢！

【问题讨论】：

学习VBA首先要了解的是子程序和函数的区别。当您想要简单地将适当的值添加到单个单元格时，请使用函数。当您想要执行任何其他形式的数据表操作时，您需要使用子例程。因此，我不确定您希望代码能为您做什么。如果你能澄清一点，我很乐意提供帮助
不清楚您要做什么。你能详细说明一下吗？请包括应评估哪些数据、您希望如何评估以及预期结果。
嗨@RGA 谢谢你的帮助！如上图所示，我想要一个将范围作为输入的函数（例如 A1:A13）。该函数应输出一个包含范围内容的数组（上面的 A18:A21），因此不应考虑空白。因此，如果在图片中的范围内调用该函数（以绿色显示），则输出应该是右侧的单元格（在图片中以白色显示）。是不是更清楚了？
认为您仍然在混淆函数和子程序，但根据您的描述，我相信您想要一个子程序，它会采用给定范围，然后只粘贴非空白单元格中的值，去掉中间的空格。对吗？
正确！很抱歉让您感到困惑！

标签： arrays vba excel

【解决方案1】：

If 语句和循环是代码块。你不能交错代码块。

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

【讨论】：

【解决方案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

【讨论】：

【解决方案3】：

根据您在该线程中的问题和 cmets，我了解您希望采用给定范围（提供给程序）并将所有非空值打印到从 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

【讨论】：