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

我正在试图做一个函数，在一维数组，过滤掉空单元格，然后浓缩数组并返回它。

例如：[1] [2] [3] [“”] [4]返回[1] [2] [3] [4]

我不断收到#Value！ 当我尝试通过索引（）调用这个新的数组。

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

尝试这个：

 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 2

试试下面：

笔记：

1. 您应该将BlankRemover定义为一个数组： Variant()
2. ArrayToCondense(CellsInArray)结束时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 3

你声明了这个函数

 Function BlankRemover(ArrayToCondense As Variant) As Variant 

所以ArrayToCondense不是一个数组，使它成为一个数组，您切换ArrayToCondense与ArrayToCondense()所以最终的代码将是：

 Function BlankRemover(ArrayToCondense As Variant) As Variant() 

Answer 4

你的代码本身有几个问题。 使新数组初始等于原始数组的大小; 然后在最后做一个“ReDim保存”。 另外，不要使用像“1”这样的值，数组可以有多个起始索引。 下面是代码在数组中的理想状态（尽pipe我将在下面注明，我不认为这实际上是你想要的）：

 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