Вариант Array несколько ошибок и сбоев - PullRequest
Новая
       35

Вариант Array несколько ошибок и сбоев

0 голосов
/ 30 января 2019

Люди из интернета, мне нужна ваша помощь!Я пытаюсь использовать вариантные массивы для суммирования большого набора данных о производительности в отдельные оценки.

У меня есть таблица с около 13000 строк и около 1500 сотрудников, чтобы пройти через них.

Я не новичок в VBA и ранее использовал этот метод, поэтому я не знаю, что происходит не так.

Я либо получаю «Нижний индекс вне диапазона», когда цикл for превышает циклUBound массива или связки «Next без For», «End Select без Select» независимо от того, есть «End» или «Next» или нет.

Пожалуйста, помогите? 

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

Ответы [ 2 ]

0 голосов
/ 30 января 2019

Мне нужно было сделать нечто подобное, когда в списке пользователей были дубликаты, поэтому я создал массив уникальных имен пользователей: 

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
0 голосов
/ 30 января 2019

Быстрая перезапись без использования 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
...