Question

我很难解决问题。我刚刚开始编码，我想创建一个宏来检查3个变量（1个用于日期，2个用于位置），而不使用Selection函数。

我想要达到的目标是让一个单元格用一个日期（A）检查1个单元格，以确定日期是否在今天之前，以及该单元格是否为空白。它要么写'＃34;过期＆＃34; （如果日期在今天之前）或左侧单元格中的文本。

然后它将移动到下面的单元格并再次执行此操作。尽管这很有效，但速度非常慢，我想知道是否还有其他方法可以用来加快速度（8000线这真的不值得）。也许使用过滤器？

非常感谢任何帮助！

Dim status As String
Dim exp As Date
Dim i As Integer
Dim n As Integer
Dim m As Integer


i = 0
n = 1
status = 1
m = 1

Do While status <> ""

    Cells.Find(What:="A", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(n, 0).Select

    exp = Selection

    Cells.Find(What:="B", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

   ActiveCell.Offset(m, 0).Select



    status = ActiveCell.Offset(i, -1).Value

    MsgBox (status)

    If exp <> 0 And exp < Date Then
        ActiveCell.FormulaR1C1 = "Expired"
    Else
        ActiveCell.FormulaR1C1 = status
    End If

    i = i - 1
    n = n + 1
    m = m + 1

Loop

Example

编辑：我认为这或多或少以简单的方式展示了我想做的事情。目的是仅在日期之前更改状态文本。但是，可能会有其他列（如Amount），所以我想避免静态范围，如果是25000行，则选择方法是VERRRY慢。我确实觉得我已经过分复杂了这一点。

Answer 1

您可以将范围对象的所有值都捕获到2d数组变量，然后您可以使用该数组。它的速度快得多

E.g。假设你在a1：c6范围内有许多不同的值，你需要循环通过值

Dim var2d As Variant, r As Range
Set r = ActiveSheet.Range("A1:C6")
var2d = r   ' var2d becomes a 6x3 array
Msgbox var2d(2,1) ' print value of cell A2
var2d(3,2) = "Expired"
var2d(5,1) = 123
r.Value = var2d  ' write the modified array back to a1:c6

Answer 2

你可以做这样的事情

Dim status As String
Dim exp As Date
Dim i As Integer
Dim n As Integer
Dim m As Integer

Dim c As Range, d As Range

i = 0
n = 1
status = 1
m = 1

With ActiveSheet
    Set d = .Range("A1")
    Do While status <> ""
        Set c = .Cells.Find(what:="A", after:=d, LookIn:=xlFormulas _
                , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
        If Not c Is Nothing Then
            exp = c.Offset(n, 0).Value2
            Set d = .Cells.Find(what:="B", after:=c.Offset(n, 0), LookIn:=xlFormulas _
                    , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
            If Not d Is Nothing Then
                With d.Offset(m + i, -1)
                    .Select
                    status = .Value2
                    MsgBox status

                    If exp <> 0 And exp < Date Then
                        .Value2 = "Expired"
                    Else
                        .Value2 = status
                    End If
                End With
            End If
        End If

        i = i - 1
        n = n + 1
        m = m + 1
    Loop
End With

Answer 3

我已经提出了一些更适合你提出的案例的编码：

它将在新工作簿上设置一些测试数据，并且没有列地址是硬编码的。

它还将展示如何创建一个listobject并以面向对象的方式引用它的各种元素，而不需要硬编码地址

最后，它使用listobject的过滤功能来执行过滤（它与基于表单的自动过滤器大致相同）

运行Main（）子程序以启动演示。

Fragment

如果在VBA中没有选择，我如何循环2个或更多变化的变量？

3 个答案: