Question

我正在尝试创建一个接收一维数组的函数，用空单元格过滤掉，然后压缩数组并返回它。

示例：[1] [2] [3] [＆＃34;＆＃34;] [4]返回[1] [2] [3] [4]

我不断获得#Value！当我尝试通过index（）调用这个新数组时。

Function BlankRemover(ArrayToCondense As Variant) As Variant

Dim ArrayWithoutBlanks() As Variant
Dim CellsInArray As Long
Dim ArrayWithoutBlanksIndex As Long

ArrayWithoutBlanksIndex = 1

    For CellsInArray = LBound(ArrayToCondense) To UBound(ArrayToCondense)

        If ArrayToCondense(CellsInArray) <> "" Then

        ArrayWithoutBlanks(ArrayWithoutBlanksIndex) = ArrayToCondense(CellsInArray).Value

        ArrayWithoutBlanksIndex = ArrayWithoutBlanksIndex + 1

        End If

    Next CellsInArray

ReDim Preserve ArrayWithoutBlanks(LBound(ArrayToCondense) To ArrayWithoutBlanksIndex)

ArrayWithoutBlanks = Application.Transpose(ArrayWithoutBlanks)
BlankRemover = ArrayWithoutBlanks

End Function

Answer 1

尝试以下：

说明：

您应该将BlankRemover定义为数组：Variant()

.Value

ArrayToCondense(CellsInArray)

代码：

Function BlankRemover(ArrayToCondense As Variant) As Variant()

Dim ArrayWithoutBlanks() As Variant
Dim CellsInArray As Long
Dim ArrayWithoutBlanksIndex As Long

ArrayWithoutBlanksIndex = 0

    For CellsInArray = LBound(ArrayToCondense) To UBound(ArrayToCondense)

        If ArrayToCondense(CellsInArray) <> "" Then

        ReDim Preserve ArrayWithoutBlanks(ArrayWithoutBlanksIndex)

        ArrayWithoutBlanks(ArrayWithoutBlanksIndex) = ArrayToCondense(CellsInArray)

        ArrayWithoutBlanksIndex = ArrayWithoutBlanksIndex + 1

        End If

    Next CellsInArray

    'ArrayWithoutBlanks = Application.Transpose(ArrayWithoutBlanks)
    BlankRemover = ArrayWithoutBlanks

End Function 'BlankRemover

Answer 2

您宣布了该功能

Function BlankRemover(ArrayToCondense As Variant) As Variant

因此ArrayToCondense不是数组，要将ArrayToCondense与ArrayToCondense()切换为数组，所以最终代码为：

Function BlankRemover(ArrayToCondense As Variant) As Variant()

Answer 3

试试这个：

Function BlankRemover(ArrayToCondense As Variant) As Variant()

Dim ArrayWithoutBlanks() As Variant
Dim CellsInArray As Variant
ReDim ArrayWithoutBlanks(1 To 1) As Variant
For Each CellsInArray In ArrayToCondense
    If CellsInArray <> "" Then
        ArrayWithoutBlanks(UBound(ArrayWithoutBlanks)) = CellsInArray
        ReDim Preserve ArrayWithoutBlanks(1 To UBound(ArrayWithoutBlanks) + 1)
    End If
Next CellsInArray

ArrayWithoutBlanks = Application.Transpose(ArrayWithoutBlanks)
BlankRemover = Application.Transpose(ArrayWithoutBlanks)

End Function

Answer 4

您的代码本身存在一些问题。使新数组最初等于原始数组的大小;然后做一个＆＃34; ReDim Preserve＆＃34;在末尾。此外，不要使用像＆＃34; 1＆＃34;这样的值，数组可以有多个起始索引。以下是使用数组执行此操作时理想情况的代码（尽管我在下面注意到，但我并不认为这实际上就是你的意思想）：

Function blankRemover(arr As Variant) As Variant

    If Not IsArray(arr) Then
        Exit Function
    End If

    ReDim newArr(LBound(arr) To UBound(arr))
    Dim i As Long
    Dim j As Long
    j = LBound(arr)

    For i = LBound(arr) To UBound(arr)
        If Not arr(i) = "" Then
            newArr(j) = arr(i)
            j = j + 1
        End If
    Next

    ReDim Preserve newArr(LBound(arr) To j - 1)
    blankRemover = newArr

End Function

但根据你的评论，听起来你并没有真正将这个功能传递给一个阵列：你将它传给了一个范围。所以你实际上想要使用这样的东西：

Function blankRemoverRng(rng As Range) As Variant

    If Not ((rng.Rows.Count = 1) Xor (rng.Columns.Count = 1)) Then
        Exit Function
    End If

    Dim arr As Variant
    arr = narrow2dArray(rng.Value)

    ReDim newArr(LBound(arr) To UBound(arr))
    Dim i As Long
    Dim j As Long
    j = LBound(arr)

    For i = LBound(arr) To UBound(arr)
        If Not arr(i) = "" Then
            newArr(j) = arr(i)
            j = j + 1
        End If
    Next

    ReDim Preserve newArr(LBound(arr) To j - 1)
    blankRemoverRng = newArr

End Function
Function narrow2dArray(ByRef arr As Variant, Optional ByVal newBase As Long = 1) As Variant
'Takes a 2d array which has one dimension of size 1 and converts it to a 1d array with base newBase
'IE it takes an array with these dimensions:
    'Dim arr(1 To 10, 1 To 1)
'And turns it into an array with these dimensions:
    'Dim arr(1 To 10)

    On Error GoTo exitStatement
    Dim bigDim As Integer
    If Not IsArray(arr) Then
        Dim smallArr(1 To 1) As Variant
        smallArr(1) = arr
        narrow2dArray = smallArr
        Exit Function
    ElseIf LBound(arr, 1) = UBound(arr, 1) Then
        bigDim = 2
    ElseIf LBound(arr, 2) = UBound(arr, 2) Then
        bigDim = 1
    Else
        GoTo exitStatement
    End If

    ReDim tempArr(newBase To UBound(arr, bigDim) - LBound(arr, bigDim) + newBase) As Variant

    Dim i As Long
    Dim j As Long
    j = LBound(arr, bigDim)
    If bigDim = 2 Then
        For i = LBound(tempArr) To UBound(tempArr)
            If IsObject(arr(1, j)) Then
                Set tempArr(i) = arr(1, j)
            Else
                tempArr(i) = arr(1, j)
            End If
            j = j + 1
        Next
    Else
        For i = LBound(tempArr) To UBound(tempArr)
            If IsObject(arr(j, 1)) Then
                Set tempArr(i) = arr(j, 1)
            Else
                tempArr(i) = arr(j, 1)
            End If
            j = j + 1
        Next
    End If
    On Error GoTo 0

    narrow2dArray = tempArr
    Exit Function

exitStatement:
    MsgBox "Error: One of array's dimensions must have size = 1"
    On Error GoTo 0
    Stop

End Function

Answer 5

对于那些稍后来寻找简单答案的人：

Filter(arrayElement, "", False)

使用VBA过滤掉数组中的空单元格

5 个答案:

说明：