有没有办法让这个不那么老套/正常工作？

Question

我有一个函数可以根据唯一 ID 检查当前行下的行。当前记录下最多可以有 6 个独特的想法（循环变量 = i）与循环中正在检查的当前记录相匹配。完成此操作后，将检查下面的记录是否有特定条件（循环变量 x）。但是，由于某种原因，我遇到了几个问题。首先是我必须在两个循环内设置范围引用，否则会出错。第二个是，在 x 循环之后的所有东西似乎都在它之前的 i 循环中输出。我做错了什么，我怎样才能正确地使用这个功能？

请在下面找到我的代码：

Function First_check()
dim i as long, x as long
Dim numComponents As Variant
Dim in1 As Range, in2 As Range, in3 As Range, in4 As Range, in5 As Range, _
in6 As Range, in7 As Range, in8 As Range, in9 As Range, in10 As Range, _
in11 As Range, in12 As Range, in13 As Range, in14 As Range, in15 As Range, _
in16 As Range, in17 As Range, in18 As Range, in19 As Range, in20 As Range
Dim out1 As Range, out2 As Range, out3 As Range, out4 As Range, out5 As Range, _
out6 As Range, out7 As Range, out8 As Range, out9 As Range, out10 As Range, _
out11 As Range, out12 As Range, out13 As Range, out14 As Range, out15 As Range, _
out16 As Range, out17 As Range, out18 As Range, out19 As Range, out20 As Range
Dim str, msg, oft, BTG, LOB, pdf, mht, emails, zip_rar, xls, doc, xls_doc, mrTT, lobVal, cmt1, giveURL, giveURLm As String

lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

For i = 2 To lastRow
 If Cells(i, 5).Value2 = Cells(i + 6, 5).Value2 Then 
     numComponents = 6
 ElseIf Cells(i, 5).Value2 = Cells(i + 5, 5).Value2 Then
     numComponents = 5
 ElseIf Cells(i, 5).Value2 = Cells(i + 4, 5).Value2 Then
     numComponents = 4
 ElseIf Cells(i, 5).Value2 = Cells(i + 3, 5).Value2 Then
     numComponents = 3
 ElseIf Cells(i, 5).Value2 = Cells(i + 2, 5).Value2 Then
     numComponents = 2
 ElseIf Cells(i, 5).Value2 = Cells(i + 1, 5).Value2 Then
     numComponents = 1
 Else
     numComponents = 0
 End If

 For x = i + 1 To i + numComponents

    Set in1 = Cells(i, 11) 'test
    Set in2 = Cells(i, 12) 
    Set in3 = Cells(i, 13) 
    Set in4 = Cells(i, 16) 'e
    Set in5 = Cells(i, 37) 'target date 
    Set in6 = Cells(i, 38) 'target date end
    Set in7 = Cells(i, 35) 'target date actual 
    Set in8 = Cells(i, 37) 'target date start
    Set in9 = Cells(i, 38) 'target date end
    Set in10 = Cells(x, 50) ' date start
    Set in11 = Cells(x, 51) ' date end
    Set in12 = Cells(i, 42) 'pro
    Set in13 = Cells(i, 43) 'reco
    Set in14 = Cells(x, 62) 'cert
    Set in15 = Cells(x, 63) 'com
    Set in16 = Cells(x, 64) 'comp
    Set in17 = Cells(x, 49) 'uniqueID
    'outs
    Set out1 = Cells(i, 72) 'test
    Set out2 = Cells(i, 73) '
    Set out3 = Cells(i, 74) '
    Set out4 = Cells(i, 75) 'e
    Set out5 = Cells(i, 76) 'tar
    Set out6 = Cells(i, 77) 'comp
    Set out7 = Cells(i, 78) 'pro
    Set out8 = Cells(i, 75) 'empty
    Set out9 = Cells(i, 80) 'cer
    Set out10 = Cells(i, 81) 'comp
    Set out11 = Cells(i, 85) 'pre
    Set out12 = Cells(i, 88) 'missing
    Set out13 = Cells(i, 89) 'missing2
    Set out14 = Cells(i, 71) 'uniqueID
    '------ATTACHMENT SET
    str = Cells(i, 46).Value2
    msg = UBound(Split(str, ".msg"))
    oft = UBound(Split(str, ".oft"))
    BTG = UBound(Split(str, "BTG"))
    LOB = UBound(Split(str, "LOB"))
    pdf = UBound(Split(str, ".pdf"))
    mht = UBound(Split(str, ".mht"))
    emails = msg + oft + pdf + mht
    zip_rar = UBound(Split(str, ".zip"))
    xls = UBound(Split(str, ".xls"))
    doc = UBound(Split(str, ".doc"))
    xls_doc = xls Or doc

    If (in8.Value2 <> in10.Value2) Or (in9.Value <> in11.Value2) Then 'date
        out6.Value2 = Cells(x, 49).Value2 & ", " & out6.Value2
    End If

    If IsBlank(in14.Value2) Then 'Check cer
        out9.Value2 = Cells(x, 49).Value2 & ", " & out9.Value2
    End If

    If IsBlank(in15.Value2) Or IsBlank(in16.Value2) Then 'check loc
        out10.Value2 = Cells(x, 49).Value2 & ", " & out10.Value2
    End If

    If Not IsBlank(in17.Value2) Then
        out14.Value2 = in17.Value2 & ", " & out14.Value2
    End If

Next x

If Not IsBlank(out6.Value2) Then 'date
    out6.Value2 = "Wrong dates"
    out6.Value2 = fixtrail(out6.Value2)
End If

 If Not IsBlank(out9.Value2) Then 'cert
    out9.Value2 = "Cert Issue"
    out9.Value2 = fixtrail(out9.Value2)
 End If

 If Not IsBlank(out10.Value2) Then 'comp
    out10.Value2 = "Comp not found"
    out10.Value2 = fixtrail(out10.Value2)
 End If

 If IsBlank(in1.Value2) Then
    out1.Value2 = "Missing type"
 End If


'
'many more checks happening that i omittied for brevity
'


  If numComponents = 0 Then
    Cells(i, 70).Value2 = "0"
Else
    Cells(i, 70).Value2 = numComponents
End If


 i = i + numComponents

Next i
End Function

Answer 1

想到的第一个想法是使用Range 对象数组来清理变量声明：

Dim inRange(20) As Range
Dim outRange(20) As Range

'...

For x = i + 1 To i + numComponents
    Set inRange(1) = Cells(i, 11)
    Set inRange(2) = Cells(i, 12)
    '...
Next

如果您可以获得映射到每个数组位置的单元格编号的公式，这将特别有效。

此外，我们可以围绕两个循环的嵌套方式改进变量。外循环使用i 变量，而内循环使用x 变量。由于这些都在查看行，因此我将它们重命名为 r0 和 r1（或 rBase 和 rNested、rParent 和 rChild、rMaster 和 rDetail 等）帮助您了解每个索引所查看的内容。我还看到一些 Range 对象依赖于当前的i 值，而另一些依赖于x。您应该能够在内部循环上方分配 i 范围，并以这种方式节省一些 CPU/内存工作：

For irParent = 2 To LastRow

    '...

    Set inRange(1) = Cells(irParent, 11) 'test
    Set inRange(2) = Cells(irParent, 12) 
    Set inRange(3) = Cells(irParent, 13) 
    Set inRange(4) = Cells(irParent, 16) 'e
    '...

    'If numComponents is 0, there are no child rows and this loop is skipped
    For rChild = rParent + 1 To rParent + numComponents
        Set inRange(10) = Cells(irChild, 50) ' date start
        Set inRange(11) = Cells(irChild, 51) ' date end

        '...

        str = Cells(irParent, 46).Value2
        msg = UBound(Split(str, ".msg"))
        oft = UBound(Split(str, ".oft"))
        '...

    Next

    irParent = irParent + numComponents
Next

另一件事是这种方法运行时间有点长。您可能希望将一些检查抽象为一个单独的方法，或者一些取决于您正在查看的父记录类型的单独方法。创建只接受检查特定类型行所需值的方法，然后返回单个结果进行检查。这会将 names 添加到代码中，以帮助您了解自己在做什么，并缩短父代码以使其更易于阅读和更快地从高层次上理解。

当您进行其他更改时，您可能希望开始考虑创建代表整行（或行中的部分）的 Range 对象，以便将它们传递给方法。尤其如此，因为目前似乎有许多 Range 对象用于保存来自单个单元格的值。您可以构建字符串来定义具有每行所需值的非连续范围（包括在子行中工作时的父单元格）。如果您可以让它们简单地接受您知道其中包含正确单元格的单个 Range 对象，这将使构建函数变得更加容易。

这也很有帮助，因为它可以最大限度地减少从 Excel 单元格复制到内存的情况。在 VBA 和 Excel 之间移动数据是一项昂贵的操作。批量复制到一组单元格或从一组单元格中复制通常比一次复制一个单元格更好。即使这意味着使用一些额外的内存，这通常也成立。它通常还有助于减少或简化所需的代码总量。不幸的是，我离 VBA 太远了，无法向您展示示例。

最后，注意我的缩进。专业人士会始终如一地这样做……甚至虔诚地这样做。 “Hacky”代码没有。这对于发现错误非常有帮助。