#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»?