变体数组多个错误和失败答案

【问题标题】：Variant Array multiple errors and failure变体数组多个错误和失败
【发布时间】：2019-06-23 21:37:15
【问题描述】：

互联网的人们，我需要你的帮助！我正在尝试使用变体数组将性能数据的大型数据集汇总为单个分数。

我有一个包含大约 13000 行和大约 1500 名员工的表来循环遍历。

我对 VBA 并不陌生，之前使用过这种方法，所以我不知道出了什么问题。

当for循环超过数组的UBound时，我要么得到“下标超出范围”，要么得到一堆“没有For的下一个”，“没有选择的结束选择”，无论是“结束”还是“下一个”有没有。

请帮忙？

Sub createScore()

Dim loData As ListObject
Dim arrData() As Variant, arrSummary As Variant
Dim lRowCount As Long, a As Long, b As Long
  Set loData = Sheets("DataMeasure").ListObjects("tbl_g2Measure")
    arrData = loData.DataBodyRange
    lRowCount = Range("A6").Value

    Range("A8").Select
    For a = 1 To lRowCount
      Selection.Offset(1, 0).Select

        For b = LBound(arrData) To UBound(arrData)
          If arrData(b, 2) = Selection Then
            Select Case arrData(b, 8)
               Case "HIT"
                Selection.Offset(0, 3) = Selection.Offset(0, 3) + 1
            End Select
          End If
        Next b

    Next a
    Range("A8").Select

End Sub

【问题讨论】：

下标超出范围很明显；您将超出数组的范围。其余的听起来像是您的条件问题。我会一步一步来看看发生了什么。
不要使用 Select stackoverflow.com/questions/10714251/…
所以我尝试了 "For b" 1 到 13237，但在休息时它仍然设法达到 13238。
我不确定我是否理解您的代码的意义。您只是想根据条件填充一个单元格吗？如果是这样，您可以在 Excel 中使用 IF 语句。此外，您的第一个循环似乎没有做任何事情，最后为什么要使用数组？无论如何，你并没有真正用它做任何事情。
.Select 几乎总是一个性能问题

标签： arrays excel vba variant subscript

【解决方案1】：

不使用Select 的快速重写。尽管如此，这仍然没有从数组中获得任何收益。

Sub createScore()
    Dim loData As ListObject
    Dim arrData() As Variant, arrSummary As Variant
    Dim lRowCount As Long, a As Long, b As Long

    Set loData = Sheets("DataMeasure").ListObjects("tbl_g2Measure")
    arrData = loData.DataBodyRange
    lRowCount = Range("A6").Value

    ' Update with correct sheet reference
    With ActiveSheet.Range("A8")
        For a = 1 To lRowCount
            For b = LBound(arrData, 1) To UBound(arrData, 1)
                If arrData(b, 2) = .Offset(a, 0).Value2 And arrData(b, 8) = "HIT" Then
                    .Offset(a, 3) = .Offset(a, 4)
                End If
            Next b
        Next a
    End With
End Sub

【讨论】：

【解决方案2】：

我需要在用户列表重复的地方做类似的事情，所以我创建了一组唯一用户名：

Dim arr() As String
lrn = 13237 'ActiveSheet.Range("A1").Range("A1").SpecialCells(xlCellTypeLastCell).Row
ac = 0
ReDim arr(0 To ac) As String
For Each c In Range("L2:L" & lrn)
    If Not IsEmpty(c.Value) Then
        If Not (UBound(Filter(arr, c.Value)) > -1) Then
            If ac > 0 Then ReDim Preserve arr(0 To ac)
            arr(ac) = c.Value
            ac = ac + 1
        End If
    End If
    DoEvents
Next c

【讨论】：