Arrays 如何在VB excel中查找值并创建值数组？

我对此有问题。我必须在一个

列（“E”）

中找到非空白单元格，将它们放入一个数组中，然后列出该数组。我尝试了这个，但是数组没有正确填充

    Dim k As Integer
    Dim X() As String

    k = 0
    dimX = Application.CountA(Range("E2:E2498")) 
    ReDim X(1 To dimX)

    For i = 2 To 2498
     If IsEmpty(Cells(i, "E")) Then
      k = k + 1
      X(k) = Cells(i, "E").Value
     End If
    Next i

---

您可能需要检查单元格是否为空：

尝试更改：

If IsEmpty(Cells(i, "E")) Then

致：

顺便说一句，您应该在代码开头使用显式的

选项来强制变量声明。然后，您将添加：

Dim i As Integer,
Dim lSize As Long

注意：我用
lSize
var替换了您的
dimX
var，因为
Dim dimX
让我哭了。
您可能需要检查单元格是否为空：

尝试更改：

If IsEmpty(Cells(i, "E")) Then

致：

顺便说一句，您应该在代码开头使用显式的
选项来强制变量声明。然后，您将添加：

Dim i As Integer,
Dim lSize As Long

注意：我用一个
lSize
var替换了您的
dimX
var，因为
Dim dimX
让我哭了。
我重写了这个代码以优化速度，即：


测试前面是否有任何列E条目
使用
SpecialCells
立即返回公式和常数的范围
使用变量数组遍历列E（变量
X
所用部分）的每个区域，然后写入一维输出数组
Y

请注意，此代码从单元格中重新计算值，无论它们是基于常数的公式。它可以很容易地通过更改

X=rngArea.Value2
to
X=rngArea.Formula
Y（lngRowTot）=rngArea.Value
to
Y（lngRowTot）=rngArea.Formula
样本输出


代码

    Sub GetEm()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rngFinal As Range
    Dim rngArea As Range
    Dim X
    Dim Y
    Dim lngRow As Long
    Dim lngRowTot As Long

    'early exit if there are no values
    If Application.CountA(Columns("E")) = 0 Then
        MsgBox "Column E has no formulae or constants", vbCritical
        Exit Sub
    End If

    'quickly determine the range of constants and formulae
    On Error Resume Next
    Set rng1 = Columns("E").SpecialCells(xlFormulas)
    Set rng2 = Columns("E").SpecialCells(xlConstants)
    On Error GoTo 0
    If Not rng1 Is Nothing Then
        If Not rng2 Is Nothing Then
            Set rngFinal = Union(rng1, rng2)
        Else
            Set rngFinal = rng1
        End If
    Else
        Set rngFinal = rng2
    End If

    ReDim Y(1 To 100)

    'Look at each range area (data may not be continuous)
    For Each rngArea In rngFinal.Areas
    'Use variant arrays to popluate a single dimension string array
        If rngArea.Cells.Count > 1 Then
            X = rngArea.Value2
            For lngRow = 1 To UBound(X)
                lngRowTot = lngRowTot + 1
                If lngRowTot Mod 100 = 0 Then ReDim Preserve Y(1 To (UBound(Y) + 100))
                Y(lngRowTot) = X(lngRow, 1)
            Next
        Else
        'handle single cells
            lngRowTot = lngRowTot + 1
            If lngRowTot Mod 100 = 0 Then ReDim Preserve Y(UBound(Y) + 100)
            Y(lngRowTot) = rngArea.Value
        End If
    Next

    'cut down array to require size
    ReDim Preserve Y(1 To lngRowTot)
    MsgBox Join(Y, ", "), , "Your array is"
End Sub

我已重写此代码以优化速度，即：


测试前面是否有任何列E条目
使用
SpecialCells
立即返回公式和常数的范围
使用变量数组遍历列E（变量
X
所用部分）的每个区域，然后写入一维输出数组
Y

请注意，此代码从单元格中重新计算值，无论它们是基于常数的公式。它可以很容易地通过更改

X=rngArea.Value2
to
X=rngArea.Formula
Y（lngRowTot）=rngArea.Value
to
Y（lngRowTot）=rngArea.Formula
样本输出


代码

    Sub GetEm()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rngFinal As Range
    Dim rngArea As Range
    Dim X
    Dim Y
    Dim lngRow As Long
    Dim lngRowTot As Long

    'early exit if there are no values
    If Application.CountA(Columns("E")) = 0 Then
        MsgBox "Column E has no formulae or constants", vbCritical
        Exit Sub
    End If

    'quickly determine the range of constants and formulae
    On Error Resume Next
    Set rng1 = Columns("E").SpecialCells(xlFormulas)
    Set rng2 = Columns("E").SpecialCells(xlConstants)
    On Error GoTo 0
    If Not rng1 Is Nothing Then
        If Not rng2 Is Nothing Then
            Set rngFinal = Union(rng1, rng2)
        Else
            Set rngFinal = rng1
        End If
    Else
        Set rngFinal = rng2
    End If

    ReDim Y(1 To 100)

    'Look at each range area (data may not be continuous)
    For Each rngArea In rngFinal.Areas
    'Use variant arrays to popluate a single dimension string array
        If rngArea.Cells.Count > 1 Then
            X = rngArea.Value2
            For lngRow = 1 To UBound(X)
                lngRowTot = lngRowTot + 1
                If lngRowTot Mod 100 = 0 Then ReDim Preserve Y(1 To (UBound(Y) + 100))
                Y(lngRowTot) = X(lngRow, 1)
            Next
        Else
        'handle single cells
            lngRowTot = lngRowTot + 1
            If lngRowTot Mod 100 = 0 Then ReDim Preserve Y(UBound(Y) + 100)
            Y(lngRowTot) = rngArea.Value
        End If
    Next

    'cut down array to require size
    ReDim Preserve Y(1 To lngRowTot)
    MsgBox Join(Y, ", "), , "Your array is"
End Sub

什么样的数组，一维字符串数组，二维数组等？在E列中有公式单元格和/或常量（文本字符串或硬编码数字）吗？现在运行代码（doh）是我的第一个问题。。。。上面的代码将在两个公式/值上运行，并返回值（正如我下面的代码所做的那样）什么类型的数组、一维字符串数组、二维数组等？在E列中有公式单元格和/或常量（文本字符串或硬编码数字）吗？现在运行代码（doh）是我的第一个问题。。。。上面的代码将在两个公式/值上运行，并返回值（正如我下面的代码所做的那样）Nice one。当我回答这个问题时，我尝试了一个
array=Columns（“E”）.SpecialCells（xlConstants）.Value
，但它不起作用，因为它在第一个空值处停止（希望避免任何循环）。不错的代码：）不错。当我回答这个问题时，我尝试了一个
array=Columns（“E”）.SpecialCells（xlConstants）.Value
，但它不起作用，因为它在第一个空值处停止（希望避免任何循环）。不过代码不错：）