Подсчет активных задач в цикле событий заданного типа

Это ответ, который у меня есть для двух столбцов. Но я хочу сделать это для трех столбцов. Может ли кто-нибудь помочь мне здесь?

Вам лучше использовать альтернативные массивы, а не клеточные контуры - они намного быстрее кода, когда наборы данных имеют смысл. Даже если код длиннее:)

Этот пример ниже сбрасывается в столбцы C и D, чтобы вы могли видеть исходные данные. Изменить [c1] .Resize (lngCnt, 2) .Value2 = Application.Transpose (Y) - [a1] .Resize (lngCnt, 2) .Value2 = Application.Transpose (Y) для сброса исходных данных

[Обновлено с помощью регулярного выражения для удаления каких-либо пробелов после, т. е. «, band» становится «полосой»] Sub SliceNDice() Dim objRegex As Object Dim X Dim Y Dim lngRow As Long Dim lngCnt As Long Dim tempArr() As String Dim strArr Set objRegex = CreateObject("vbscript.regexp") objRegex.Pattern = "^\s+(.+?)$" 'Define the range to be analysed X = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2 Redim Y(1 To 2, 1 To 1000) For lngRow = 1 To UBound(X, 1) 'Split each string by "," tempArr = Split(X(lngRow, 2), ",") For Each strArr In tempArr lngCnt = lngCnt + 1 'Add another 1000 records to resorted array every 1000 records If lngCnt Mod 1000 = 0 Then Redim Preserve Y(1 To 2, 1 To lngCnt + 1000) Y(1, lngCnt) = X(lngRow, 1) Y(2, lngCnt) = objRegex.Replace(strArr, "$1") Next Next lngRow 'Дампом переупорядоченный диапазон в столбцы C: D [c1] .Resize (lngCnt, 2) .Value2 = Application.Transpose (Y) End Sub