управление ячейками Excel и запись их в другие ячейки

Question

У меня есть лист Excel, как показано ниже. Я хочу найти некоторые строки в третьей ячейке моего Excel. Строка составляет 180 дней . Когда значение ячейки включает 180 дней , я хочу записать предыдущее значение ячейки рядом с пустыми ячейками, как показано на рисунке ниже. Я хочу написать план процесса в первой ячейке, название операции во второй ячейке. Я написал этот код, но он работает не так, как я хочу.

Sub Button1_Click()
    Dim excelRange As Long
    Dim i As Long
    Dim k As Long
    'Dim txt As String
    excelRange = ActiveSheet.Cells(1048576, 3).End(xlUp).Row
    k = 2
    For a = 2 To excelRange
        txt = Cells(a, 3)
        k = a
        If InStr(1, txt, "180 days") > 0 Then
            For i = a To 2 Step -1
                txt1 = Cells(i, 3)
                If InStr(1, txt1, "Oper Title") > 0 Then
                    Cells(a, 2) = Cells((k + 1), 3)
                ElseIf InStr(1, txt1, "Process") > 0 Then
                    Cells(a, 1) = Cells(k, 3)
                Else:
                    k = k - 1
                End If
            Next i
        End If
    Next a
End Sub

Answer 1

Sub test()

Dim excelRange  As Range
Dim criteriRange As Range
Dim evaluateRange As Range
Dim c As Range
Dim i As Long

Set excelRange = Range("C1:C" & Cells(1048576, 3).End(xlUp).Row)

For Each cell In excelRange
    If UCase(cell.Text) Like "*180 DAY*" Then
        If criteriRange Is Nothing Then
            Set criteriRange = cell
        Else
            Set criteriRange = Union(criteriRange, cell)
        End If
    End If
Next

If Not criteriRange Is Nothing Then
    For Each c In criteriRange
        For i = c.Row To 1 Step -1
            If UCase(Cells(i, 3)) Like "*PROCESS PLAN*" Then
            c.Offset(0, -2) = Cells(i, 3)
            Exit For
            End If
        Next
        For i = c.Row To 1 Step -1
            If UCase(Cells(i, 3)) Like "*OPER TITLE*" Then
            c.Offset(0, -1) = Cells(i + 1, 3)
            Exit For
            End If
        Next
    Next
End If


End Sub

Answer 2

Быстрое использование варианта массива.

Sub test()
    Dim Ws As Worksheet
    Dim rngDB As Range
    Dim vDB As Variant
    Dim vRow(), vTitle(), vProcess()
    Dim i As Long, j As Long, k As Long, m As Long

    Set Ws = ActiveSheet
    With Ws
        Set rngDB = .Range("a1", .Range("c" & Rows.Count).End(xlUp))
    End With

    vDB = rngDB

    For i = 1 To UBound(vDB, 1)
        If InStr(vDB(i, 3), "180 days") Then
            j = j + 1
            ReDim Preserve vRow(1 To j)
            vRow(j) = i
        ElseIf InStr(vDB(i, 3), "Oper Title") Then
            k = k + 1
            ReDim Preserve vTitle(1 To k)
            vTitle(k) = vDB(i + 1, 3)
        ElseIf InStr(vDB(i, 3), "Process") Then
            m = m + 1
            ReDim Preserve vProcess(1 To m)
            vProcess(m) = vDB(i, 3)
        End If
    Next i
    For i = 1 To j
        vDB(vRow(i), 1) = vProcess(i)
        vDB(vRow(i), 2) = vTitle(i)
    Next i
    rngDB = vDB

End Sub

Answer 3

Вместо циклического перемещения по диапазону ваш макрос будет работать намного быстрее, если вы используете метод Range.Find.

В своем коде вы не проверяли, чтобы все ваши наборы из Process | Title | 180 Days завершено. Я добавил это в приведенный ниже код, убедившись, что строки Process и Title были найдены после предыдущей строки 180 day (или перед строкой 180 day для первого экземпляра).

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

Надеемся, что благодаря комментариям и использованию значимых имен переменных вы сможете понять, что такое продолжается. Но вы также можете прочитать справку VBA для метода Range.Find.

В общем, мы ищем вниз, чтобы найти строку 180 day, затем ищем оттуда, чтобы найти связанный Process и Title строки.

Если предшествующая строка Process или Title должна быть перед предыдущей строкой 180 day, то мы имеем неполный набор, выводим сообщение об ошибке и завершаем процедуру.

При необходимости вы можете разработать процедуры для обработки неполных наборов данных.

Option Explicit
Sub Info()
    Dim searchRng As Range, C As Range, cProcessPlan As Range, cOperTitle As Range
    Dim firstAddress As String 'to check when we are done
    Dim lastAddress As String 'to check for incomplete data sets

'Where are we looking?
Set searchRng = ThisWorkbook.Worksheets("Sheet1").Columns(3)

With searchRng
    Set C = .Find(what:="180 Days", after:=.Cells(1, 1), LookIn:=xlValues, _
                lookat:=xlPart, searchorder:=xlByRows, _
                searchdirection:=xlNext, MatchCase:=False)
        If Not C Is Nothing Then
            firstAddress = C.Address
            lastAddress = C.Address
            Set cOperTitle = .Find(what:="Oper Title", after:=C, searchdirection:=xlPrevious)
            Set cProcessPlan = .Find(what:="Process Plan", after:=C, searchdirection:=xlPrevious)

            If Not cOperTitle Is Nothing Or Not cProcessPlan Is Nothing Then

                'check for full set
                If cOperTitle.Row > Range(lastAddress).Row Or cProcessPlan.Row > Range(lastAddress).Row Then
                    MsgBox "Incomplete Data Set" & vbLf & "Before: " & C.Address
                    Exit Sub
                End If

                C.Offset(0, -1) = cOperTitle.Offset(1, 0)
                C.Offset(0, -2) = cProcessPlan
            Else
                MsgBox "Title or Process Plan not found"
                Exit Sub
            End If

            Do
                Set C = .Find(what:="180 Days", after:=C, LookIn:=xlValues, _
                    lookat:=xlPart, searchorder:=xlByRows, _
                    searchdirection:=xlNext, MatchCase:=False)

                If C.Address = firstAddress Then Exit Do

                Set cOperTitle = .Find(what:="Oper Title", after:=C, searchdirection:=xlPrevious)
                Set cProcessPlan = .Find(what:="Process Plan", after:=C, searchdirection:=xlPrevious)

                'check for a full set
                If cOperTitle.Row < Range(lastAddress).Row Or cProcessPlan.Row < Range(lastAddress).Row Then
                    MsgBox "Incomplete Data Set" & vbLf & "Between: " & lastAddress & " and " & C.Address
                    Exit Sub
                End If

                C.Offset(0, -1) = cOperTitle.Offset(1, 0)
                C.Offset(0, -2) = cProcessPlan


                lastAddress = C.Address
            Loop
        End If
End With
'next stuff

End Sub