gpt4 book ai didi

arrays - 如何在 VBA excel 中查找值并创建它们的数组?

转载 作者:行者123 更新时间:2023-12-04 21:26:19 24 4
gpt4 key购买 nike

我有这个问题。我必须在一个 column ("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

最佳答案

我重写了这段代码来优化速度,即:

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

  • 请注意,此代码从单元格中重新运行值,无论它们是基于常量的公式。它可以通过更改轻松更新以返回公式
  • X = rngArea.Value2X = rngArea.Formula
  • Y(lngRowTot) = rngArea.ValueY(lngRowTot) = rngArea.Formula

  • 样本输出

    code sample

    代码
        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

    关于arrays - 如何在 VBA excel 中查找值并创建它们的数组?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/8710452/

    24 4 0
    Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
    广告合作:1813099741@qq.com 6ren.com