Поиск кода для извлечения данных из столбца A, когда любая ячейка в столбцах B - AH не равна нулю - PullRequest
0 голосов
/ 19 января 2019

У меня есть две таблицы. Один пустой, другой содержит данные. Я открываю оба и мне нужно извлечь данные из того, который содержит данные, и вставить их в пустую электронную таблицу. Критерием является копирование ячейки A, когда любая ячейка от B до AH не равна нулю, и вставка данных из ячейки A в пустую электронную таблицу. Количество рядов варьируется. Ячейки B-AH будут либо нулевыми, либо содержат целое число (1 - 5). Если ЛЮБАЯ ячейка в B - AH содержит целое число, мне нужно скопировать ячейку A в пустую электронную таблицу.

Я знаю, как найти последнюю ячейку и цикл из строки 1 в последнюю ячейку, но не уверен, как бы я прошел по столбцам B - AH, чтобы найти первую ненулевую ячейку.

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

1 Ответ

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

Этот код должен делать то, что вы хотите. Он определяет наличие целых чисел в диапазоне B: AH с помощью функции рабочего листа COUNT ().

Private Sub CountIntegers()

    Dim Arr As Variant                  ' output array
    Dim Rng As Range
    Dim Rl As Long                      ' last row
    Dim R As Long                       ' row counter
    Dim i As Long                       ' index of Arr

    With ActiveSheet
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        ReDim Arr(1 To Rl)
        For R = 2 To Rl                 ' assuming row 1 to have headers
            Set Rng = Range(.Cells(R, "B"), .Cells(R, "AH"))
            If Application.Count(Rng) Then
                i = i + 1
                Arr(i) = .Cells(R, "A").Value
            End If
        Next R
    End With

    ReDim Preserve Arr(i)
    ' specify the output sheet here:-
    Set Rng = Worksheets("Sheet2").Cells(2, 1).Resize(i)
    Rng.Value = Application.Transpose(Arr)
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...