использование диапазона строк для затемнения массива и использование массива для итерации по циклу For

#arrays #excel #vba #loops

#массивы #excel #vba #циклы

Вопрос:

Пожалуйста, посмотрите на мои примеры данных и кода, чтобы понять, что я пытаюсь сделать.

Мне нужно использовать значение ячеек (, 3), чтобы определить диапазон для заполнения массива Trialnumber(18). Мне нужен массив для итерации по циклу For, для подсчета заполненных ячеек в столбце H для каждого испытания и вывода количества в столбец T в последней строке каждого испытания. Мне также понадобится массив для дальнейшего анализа данных в будущем (если кто-то не сможет предложить лучшее решение).

На данный момент я экспериментирую с 3 модулями кода, пытаясь получить желаемое решение.

Модуль 2 — единственный, в котором нет ошибок, и он печатает значение в правой ячейке, но он печатает общее количество заполненных ячеек (562), а не за пробную версию (ожидаемое значение = 1 или 2).

Модуль 1 выглядит следующим образом:

 Sub dotcountanalysis()
Dim startpoint As Long
startpoint = 1
Dim lastrow As Long
lastrow = Cells(Rows.Count, 3).End(xlUp).Row
Dim i As Long

With Worksheets("full test")

For i = 1 To 18
      For n = startpoint To lastrow   1

        If Cells(n, 3).Value <> "Trial, " amp; CStr(i) Then
           Dim nMinusOne As Long
           nMinusOne = n - 1
           Dim trialCount As Long
           'Set Trialnumber(i-1) = Range(cells(startpoint, 3), cells(n-1, 3))
           trialCount = Application.WorksheetFunction.CountA(Range("H" amp; CStr(startpoint) amp; ":" amp; "H" amp; CStr(nMinusOne)))
           Range("T" amp; CStr(startpoint) amp; ":" amp; "T" amp; CStr(nMinusOne)).Value = trialCount
           startpoint = n
           Exit For
         End If

        Next n
Next i
End With
End Sub
  

Он возвращает ошибку «метод _range объекта _global falied» в строке: trialCount = Application.WorksheetFunction.CountA(Range("H" amp; CStr(startpoint) amp; ":" amp; "H" amp; CStr(nMinusOne)))

Модуль 3 выглядит следующим образом:

 Sub dotcountanalysis3()

Dim pressedCount As Long
Dim myCell As Range
Dim pressedRange As Range

'create trials array
Dim t(18) As Range

'set range for trialnumber (t)

Dim startpoint As Long
startpoint = 1
Dim lastrow As Long
lastrow = Cells(Rows.Count, 3).End(xlUp).Row

For i = 1 To 18
      For n = startpoint To lastrow
      startpoint = 7
        If Cells(n, 3).Value <> "Trial, " amp; CStr(i) Then
           Set t(i - 1) = Range(Cells(startpoint, 3), Cells(n, 3))
           n = n   1
           startpoint = n
           Exit For
         End If

        Next n
Next i

'count presses in each trial

With Worksheets("full test")
    For i = 0 To 17
    pressedCount = Application.WorksheetFunction.CountA _
    (.Range(.Cells(t(), "H"), .Cells(.Rows.Count, "H")))
    If pressedCount = 0 Then Exit Sub
    'make sure there are cells or else the next line will fail
    Set pressedRange = .Columns("H").SpecialCells(xlCellTypeConstants)

        For Each myCell In pressedRange.Cells
    'only loop through the cells containing something
        .Cells(myCell.Row, "T").Value = pressedCount
        Next myCell
    Next i
End With

End Sub
  

Он возвращает ошибку «несоответствие типов» во время выполнения в строке: pressedCount = Application.WorksheetFunction.CountA _
(.Range(.Cells(t(), "H"), .Cells(.Rows.Count, "H")))

Редактировать: я обновил код в mod 3 и обновил ошибку.

Комментарии:

1. Первая ошибка: n = 1 с первого раза, so nMinusOne равно нулю, и строки 0 нет

2. Вторая ошибка — та же проблема.

3. @TimWilliams Было бы лучше установить startpoint = 7 (строка, с которой начинаются данные) или просто использовать базу 1 для моего массива?

4. Похоже, что для каждой пробной версии есть несколько блоков — их нужно суммировать отдельно? Подразделяется на блок?

5. Под «блоком» я подразумеваю ColB «Имя блока»

Ответ №1:

При подсчете вещей мне нравится использовать объект словаря, а массивы быстрее, чем строка за строкой на листе.

Это будет учитывать уникальные комбинации Block Trial: для подсчета только по trial вы бы просто использовали k = d(r, COL_TRIAL)

 Dim dBT As Object 'global dictionary

Sub dotcountanalysis()

    'constants for column positions
    Const COL_BLOCK As Long = 1
    Const COL_TRIAL As Long = 2
    Const COL_ACT As Long = 7

    Dim rng As Range, lastrow As Long, sht As Worksheet
    Dim d, r As Long, k, resBT()

    Set sht = Worksheets("full test")
    lastrow = Cells(Rows.Count, 3).End(xlUp).Row
    Set dBT = CreateObject("scripting.dictionary")

    Set rng = sht.Range("B7:H" amp; lastrow)

    d = rng.Value  'get the data into an array

    ReDim resBT(1 To UBound(d), 1 To 1) 'resize the array which will
                                        '  be placed in ColT

    'get unique combinations of Block and Trial and counts for each
    For r = 1 To UBound(d, 1)
        k = d(r, COL_BLOCK) amp; "|" amp; d(r, COL_TRIAL) 'create key
        dBT(k) = dBT(k)   IIf(d(r, COL_ACT) <> "", 1, 0)
    Next r

    'populate array with appropriate counts for each row
    For r = 1 To UBound(d, 1)
        k = d(r, 1) amp; "|" amp; d(r, 2)   'create key
        resBT(r, 1) = dBT(k)          'get the count
    Next r

    'place array to sheet
    sht.Range("T7").Resize(UBound(resBT, 1), 1) = resBT

    'show the counts in the Immediate pane (for debugging)
    For Each k In dBT
        Debug.Print k, dBT(k)
    Next k


End Sub
  

Комментарии:

1. Боже, это потрясающе! помимо печати в debug вместо столбца T, это идеально! И так отличается от любого другого кода, который я пробовал до сих пор. Хорошо сделано и спасибо.

2. О, извините, я не рассмотрел colT должным образом. Еще раз спасибо!

3. Мой руководитель попытался использовать этот макрос на другом компьютере, и он получил ошибку во время выполнения в строке Set dBT = CreateObject . Что вызывает ошибку?

4. Это был Mac? If не будет работать на Mac. Кроме этого, это может быть какой-то антивирус, блокирующий код, или какая-то политика компании. У меня никогда не было проблем с использованием этого объекта.

5. Да, это был mac. Впоследствии я понял, что Mac не используют объект dictionary. Будет ли исправление таким же простым, как замена «scripting.dictionary» на «Collection»?