代码之家 › 专栏 › 技术社区 › ImmutableTuple

从由范围加载的数组中删除空白项

subscript for-loop vba excel arrays

ImmutableTuple · 技术社区 · 10 年前

我试图从excel数据表中名为TY[L3-Name](1列,X行长)的字段加载的数组中删除空白条目。下面的代码旨在删除数组中的所有空值(加载范围后),并返回一个新数组,其中包含仅包含数据的行。我想稍后将此数组传递到集合中以删除重复项,但我正在试图弄清楚为什么我不能先跳过空格(现在我只想了解如何做到这一点,无论我是否将此传递到其他对象)。

代码在ReDim Preserve行出错。我首先将NewArr调整为MyArr表的大小,但最后返回了空白行。然后,我尝试调整它的大小,使其中只有包含数据的行,但我似乎无法让NewArr()数组在没有错误的情况下执行此操作。

我正在使用即时窗口验证是否没有空白条目(当前在TY[L3名称]范围末尾有8行)。

Sub BuildArray()

'   Load array
Dim MyArr()
Dim j As Long

'   Size array
MyArr() = Range("TY[L3 Number]")
ReDim NewArr(LBound(MyArr) To UBound(MyArr), 1)

'   For Loop to search for Blanks and remove from Array
'   The Lbound and UBound parameters will be defined by the size of the TY[L3 Number] field in the TY Table
For i = LBound(MyArr) To UBound(MyArr)
   If MyArr(i, 1) <> "" Then
        j = j + 1
        NewArr(j, 1) = MyArr(i, 1)
   End If
   Next i
ReDim Preserve NewArr(1 To j, 1) 'Error out here; "Subscript out of range." Can't seem to get this Array to new size without blank entries.

'   Debug Window to show results of revised array.
Dim c As Long
For c = LBound(NewArr) To UBound(NewArr)
   Debug.Print NewArr(c, 1)
Next
   Debug.Print "End of List"

End Sub

2 回复 | 直到 10 年前

Community CDub 4 年前

在VBA中处理数组可能很棘手,但我认为下面的示例将向您展示如何使用不同的策略填充“无空白” Array 可能是工作:

假设我们从一张单曲开始 Worksheet ,带有 CoolRange 命名如下:

start

生成一个没有空格的数组可以这样做:

Option Explicit
Sub BuildArrayWithoutBlanks()

Dim AryFromRange() As Variant, AryNoBlanks() As Variant
Dim Counter As Long, NoBlankSize As Long

'set references and initialize up-front
ReDim AryNoBlanks(0 To 0)
NoBlankSize = 0

'load the range into array
AryFromRange = ThisWorkbook.Names("CoolRange").RefersToRange

'loop through the array from the range, adding
'to the no-blank array as we go
For Counter = LBound(AryFromRange) To UBound(AryFromRange)
    If AryFromRange(Counter, 1) <> "" Then
        NoBlankSize = NoBlankSize + 1
        AryNoBlanks(UBound(AryNoBlanks)) = AryFromRange(Counter, 1)
        ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) + 1)
    End If
Next Counter

'remove that pesky empty array field at the end
If UBound(AryNoBlanks) > 0 Then
    ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) - 1)
End If

'debug for reference
For Counter = LBound(AryNoBlanks) To UBound(AryNoBlanks)
    Debug.Print (AryNoBlanks(Counter))
Next Counter
Debug.Print "End of List"

End Sub

综上所述,我们:

为最终的数组创建一个一维数组,去掉空格
遍历原始数组(带空格)
除非数组字段为空,否则我们增加非空计数器,然后将值添加到非空数组,然后展开非空数组
吹走非空白数组中最后一个讨厌的空字段

从您的问题描述中,听起来您最终将使用 Collection --喜欢它。出于好奇,您将使用非空白但具有重复项的数组做什么?

FrequentFlyer 3 年前

我有工作表数据,可以删除其中带有“模板”的行,然后复制到另一个工作表中。与删除空行的想法相同。我将原始数据复制到INArr。我知道宽度是16(列),但长度(行)是可变的。REDIM PRESERVE只在最后一个维度上工作,所以我调换了数组,现在它是16行和无限列,同时删除了不需要的数据。将数组转换回并复制到最终工作表。

希望这是有意义的。

'Copy data from Worksheet3 to INArr, Remove "TEMPLATES" and copy to Worksheet2
LR = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
INArr = Sheet3.Range("B6:Q" & LR).Value2
ReDim TempArr(1 To 16, 1 To 1)

x = 0
For i = 1 To UBound(INArr)
    If INArr(i, 14) <> "TEMPLATES" Then
        x = x + 1
        ReDim Preserve TempArr(1 To 16, 1 To x)
        For j = 1 To 16
            TempArr(j, x) = INArr(i, j)
        Next
    End If
Next

ReDim OutArr(1 To x, 1 To 16)
For i = 1 To x
    For j = 1 To 16
        OutArr(i, j) = TempArr(j, i)
    Next
Next
Sheet2.Range("A3:P" & x + 2).Value2 = OutArr