Как вставить значение пользователя в первую пустую строку, если это значение не найдено в столбце?

Question

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

xrow = 1

For x = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row

    If InStr(1, ws1.Cells(x, 1), UserValue, vbTextCompare) > 0 Then

        ws1.Cells(x, 3) = ws2.Cells(20, 6).Value
        ws1.Cells(x, 4) = ws2.Cells(20, 7).Value
        ws1.Cells(x, 5) = ws2.Cells(20, 8).Value
        ws1.Cells(x, 6) = Application.Sum(Range(ws1.Cells(x, 3), ws1.Cells(x, 5)))
        ws1.Cells(x, 7) = ws5.Cells(9, 8).Value
        StratTotal = ws1.Cells(x, 6).Value

        ws1.Cells(x, 8) = ws3.Cells(87, 6).Value
        ws1.Cells(x, 9) = ws3.Cells(87, 7).Value
        ws1.Cells(x, 10) = ws3.Cells(87, 8).Value
        ws1.Cells(x, 11) = Application.Sum(Range(ws1.Cells(x, 8), ws1.Cells(x, 10)))
        ws1.Cells(x, 12) = ws5.Cells(9, 9).Value
        OpsTotal = ws1.Cells(x, 11).Value

        ws1.Cells(x, 13) = ws4.Cells(15, 6).Value
        ws1.Cells(x, 14) = ws4.Cells(15, 7).Value
        ws1.Cells(x, 15) = ws4.Cells(15, 8).Value
        ws1.Cells(x, 16) = Application.Sum(Range(ws1.Cells(x, 13), ws1.Cells(x, 15)))
        ws1.Cells(x, 17) = ws5.Cells(9, 10).Value
        CompTotal = ws1.Cells(x, 16).Value

        Cumulative = StratTotal + OpsTotal + CompTotal
        ws1.Cells(x, 2) = Cumulative
    ElseIf x >= 350 Then
        firstEmptyRow = ws1.Cells(x, "A").End(xlUp).Row
        ws1.Cells(firsEmptyRow, 1).Value = UserValue

        ws1.Cells(firstEmptyRow, 3) = ws2.Cells(20, 6).Value
        ws1.Cells(firstEmptyRow, 4) = ws2.Cells(20, 7).Value
        ws1.Cells(firstEmptyRow, 5) = ws2.Cells(20, 8).Value
        ws1.Cells(firstEmptyRow, 6) = Application.Sum(Range(ws1.Cells(firstEmptyRow, 3), ws1.Cells(firstEmptyRow, 5)))
        ws1.Cells(firstEmptyRow, 7) = ws5.Cells(9, 8).Value
        StratTotal = ws1.Cells(firstEmptyRow, 6).Value

        ws1.Cells(firstEmptyRow, 8) = ws3.Cells(87, 6).Value
        ws1.Cells(firstEmptyRow, 9) = ws3.Cells(87, 7).Value
        ws1.Cells(firstEmptyRow, 10) = ws3.Cells(87, 8).Value
        ws1.Cells(firstEmptyRow, 11) = Application.Sum(Range(ws1.Cells(firstEmptyRow, 8), ws1.Cells(firstEmptyRow, 10)))
        ws1.Cells(firstEmptyRow, 12) = ws5.Cells(9, 9).Value
        OpsTotal = ws1.Cells(firstEmptyRow, 11).Value

        ws1.Cells(firstEmptyRow, 13) = ws4.Cells(15, 6).Value
        ws1.Cells(firstEmptyRow, 14) = ws4.Cells(15, 7).Value
        ws1.Cells(firstEmptyRow, 15) = ws4.Cells(15, 8).Value
        ws1.Cells(firstEmptyRow, 16) = Application.Sum(Range(ws1.Cells(firstEmptyRow, 13), ws1.Cells(firstEmptyRow, 15)))
        ws1.Cells(firstEmptyRow, 17) = ws5.Cells(9, 10).Value
        CompTotal = ws1.Cells(firstEmptyRow, 16).Value

        Cumulative = StratTotal + OpsTotal + CompTotal
        ws1.Cells(firstEmptyRow, 2) = Cumulative

End If

По сути, я ищу в столбце А рабочего листа, чтобы найти имя, которое вводит пользователь, и, если оно найдено, я 'm вставка значений из листов другой рабочей книги в столбцы этой строки.

Часть, упомянутая в предыдущем абзаце, работает, но я также хочу добавить функциональность, когда после поиска в этом столбце и не найдя значения пользователя,макрос добавляет это значение (имя) в первый столбец, а затем выводит те же значения.В данный момент я добавил произвольную остановку строки 350 для цикла, так как не знал, как еще это сделать.В настоящее время значение не вставляется в первую пустую строку, и я беспокоюсь, что это может произойти из-за произвольной остановки.

Answer 1

вы можете избежать сканирования построчно и использовать Find() метод объекта Range, чтобы найти ячейку, где UserValue возможно:

Dim foundRng As Range
Set foundRng = ws1.Range("A1", ws1.Cells(.Rows.Count, 1).End(xlUp)).Find(what:=UserValue, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)

Более того, вы можете добавить логику для управлениярегистр UserValue не найден и для foundRng установлены первые пустые ячейки, если таковые имеются, или в следующей доступной пустой строке:

Dim foundRng As Range
With ws1 ' reference target sheet
    With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) ' reference referenced sheet column A range from row 1 down to last not empty one
        Set foundRng = .Find(what:=UserValue, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False) ' try and find UserValue in referenced range
        If foundRng Is Nothing And WorksheetFunction.CountBlank(.Cells) > 0 Then Set foundRng = .SpecialCells(XlCellType.xlCellTypeBlanks)
        If foundRng Is Nothing Then Set foundRng = .Cells(.Count + 1)
    End With
End With

с этого момента foundRng совпадает с вашим ws1.Cells(x, 1) и, так как вы хотите записать в последовательный диапазон ячеек, вы можете воспользоваться Resize() свойством объекта Range и функцией VBA Array() и переписать блок «записи» следующим образом:

    With foundRng ' reference found range
        .Value = UserValue

        ' write down all values from except those resulting from a sum, where you place a zero
        .Cells(1, 3).Resize(, 15).Value = Array(ws2.Cells(20, 6).Value, _
                                                ws2.Cells(20, 7).Value, _
                                                ws2.Cells(20, 8).Value, _
                                                0, _
                                                ws5.Cells(9, 8).Value, _
                                                ws3.Cells(87, 6).Value, _
                                                ws3.Cells(87, 7).Value, _
                                                ws3.Cells(87, 8).Value, _
                                                0, _
                                                ws5.Cells(9, 9).Value, _
                                                ws4.Cells(15, 6).Value, _
                                                ws4.Cells(15, 7).Value, _
                                                ws4.Cells(15, 8).Value, _
                                                0, _
                                                ws5.Cells(9, 10).Value)

        'calculate sums
        StratTotal = Application.Sum(.Cells(1, 3).Resize(, 3))
        OpsTotal = Application.Sum(.Cells(1, 8).Resize(, 3))
        CompTotal = Application.Sum(.Cells(1, 13).Resize(, 3))
        Cumulative = StratTotal + OpsTotal + CompTotal

        'fill cells with sum    
        .Cells(1, 2).Value = Cumulative
        .Cells(1, 6).Value = StratTotal
        .Cells(1, 11).Value = OpsTotal
        .Cells(1, 16).Value = CompTotal    
    End With

Answer 2

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

Dim valueWasFound As Boolean
valueWasFound = False
For x = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
    If InStr(1, ws1.Cells(x, 1), UserValue, vbTextCompare) > 0 Then
        '--- all your copying code goes here...

        '--- ... and set the flag to True
        valueWasFound = True
    End If
Next x

Теперь проверьте флаг перед следующей частью вашей логики и делайте копии в пустые строки только при необходимости.:

If valueWasFound Then
    '--- the same logic you have above... 
    firstEmptyRow = ws1.Cells(x, "A").End(xlUp).Row
    ws1.Cells(firsEmptyRow, 1).Value = UserValue

    ...
End If

Если он работает слишком медленно, вы можете скопировать диапазоны в массивы на основе памяти , что значительно улучшит скорость (если у вас большое количество строк).