неточный массив

Question

Я пытаюсь получить Excel, чтобы go вниз по столбцу чисел и подсчитать количество ячеек между каждым вхождением.

Но сначала он идет в ячейку, чтобы получить номер для поиска.

Я правильно понял первую часть. В этом он найдет номер для поиска. Затем он идет и выполняет поиск.

Моя проблема в том, что когда он возвращает массив, счетчик является неточным. Он показывает случайные числа.

То, что я узнал, из книг или net. Так что простите, грязный код lol

Первая часть выполняет поиск, а вторая часть помещает его в массив, я буду признателен за любую помощь в этом. С наилучшими пожеланиями

 If Z = 5 Then ActiveCell.Offset(0, 1).Select: Z = 0: x = x + 1
  Select Case Selection.Value
   Case Is = 1000
   GoSub passarrayp
   Case Is = 100
   ActiveCell.Offset(0, 1).Select: x = x + 1: Z = 0 'Exit Do
   Case Is = searchp
   ActiveCell.Offset(0, 1).Select: p = p + 1: DataArray1(p) = x: x = 1: Z = 0
   Case Is = 50
   Range("h:h").Select: Selection.ClearContents: Range("a3").Select: GoSub final
   Case Is <> searchp
   ActiveCell.Offset(1, 0).Select: Z = Z + 1
 End Select
  Loop
  Next Z

  GoSub passarrayp
 'Transfer the array to the worksheet
 passarrayp:
 'finds an empty cell to put the number of undrawn weeks
 Range("k46").Select
 Do While ActiveCell <> searchp
 ActiveCell.Offset(1, 0).Select
 Loop
 Do
 If ActiveCell = searchp Then ActiveCell.Offset(2, 0).Select: c = p: _
'places array values onto spreadsheet
 Selection.Resize(1, c + 1).Value = DataArray1: Exit Do
Loop
        'Zero array elements ready for next search
r = 0 ' starts the array reset from from the first element
For i = 0 To 249
r = r + 1: DataArray1(p) = 0 ' clear the  array element values to zero
Next i ' increments the elements to be zeroed

Answer 1

Я бы сделал это по-другому.

Редактировать: отредактировать код и снимок экрана, чтобы согласовать первый элемент

Собрать соответствующие номера строк в a Collection, а затем выведите массив с разницей между соответствующими номерами строк:

Option Explicit
Function countBetween(Draws As Range, LookFor As Long) As Long()
    Dim colRowNums As Collection
    Dim C As Range
    Dim rowDiffs() As Long
    Dim firstRow As Long
    Dim firstAddress As String
    Dim lTemp() As Long, I As Long

'find first row with data in Draws Range
'  we do this just in case user picked the non-numeric header row
' could do more extensive checking

If IsNumeric(Draws(1, 1)) Then
    firstRow = Draws(1, 1).Row
Else
    firstRow = Draws(2, 1).Row
End If

'collect each row number of interest
'could also loop, but `.Find` should be faster on long arrays

Set colRowNums = New Collection
With Draws
    Set C = .Find(what:=LookFor, after:=Draws(1, 1), LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
    If Not C Is Nothing Then
        firstAddress = C.Address
        colRowNums.Add C.Row

        Do
            Set C = .Find(what:=LookFor, after:=C)
            If Not C.Address = firstAddress Then
                colRowNums.Add C.Row
            Else
                Exit Do
            End If
        Loop
    End If
End With

'If first entry in Draws was LookFor, then it will be last in the list
' So check for that and exchange if necessary

If colRowNums(1) > colRowNums(colRowNums.Count) Then
    colRowNums.Add Item:=colRowNums(colRowNums.Count), before:=1
    colRowNums.Remove (colRowNums.Count)
End If

'create output array
ReDim lTemp(1 To colRowNums.Count, 1 To 1) 'for vertical outputl
lTemp(1, 1) = colRowNums(1) - firstRow + 1
For I = 2 To colRowNums.Count
    lTemp(I, 1) = colRowNums(I) - colRowNums(I - 1)
Next I

countBetween = lTemp
End Function

Функция вернет вертикальный массив значений. Если у вас есть O365 с динамическими c массивами, вы можете просто ввести:

=countBetween(Draws,LookFor)

в одну ячейку, и результаты будут отображаться.

Если вы этого не сделаете, то вы тоже не сможете введите формулу в виде формулы массива для диапазона ячеек или используйте функцию INDEX как:

=IFERROR(INDEX(countBetween(Draws,LookFor),ROWS($1:1)),"")

и заполните, пока не увидите пробелы.

РЕДАКТИРОВАТЬ для горизонтального вывода массива:

Если вы хотите горизонтальный вывод результатов, как я писал в комментарии, так как теперь у вас есть O365, все, что вам нужно сделать, это использовать функцию TRANSPOSE. Например:

=TRANSPOSE(countBetween(A2:A23,B2))

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

'for horizontal output
ReDim lTemp(1 To colRowNums.Count)
lTemp(1) = colRowNums(1) - firstRow + 1
For I = 2 To colRowNums.Count
    lTemp(I) = colRowNums(I) - colRowNums(I - 1)
Next I