Как переместить несколько строк на основе критериев в объединенной ячейке? - PullRequest
0 голосов
/ 22 января 2019

enter image description here

Я пытаюсь создать журнал проекта.Проекты отображаются горизонтально.

На листе "Open_Orders"

Столбец A пуст

Столбец B содержит заголовки информации о проекте (имя клиента, номер заказа, дата начала и т. Д..) Каждый проект имеет в общей сложности 7 строк, прежде чем будет перечислен следующий проект. Столбец C - это ответы на столбец C (также 7 строк перед началом следующего проекта). Столбец DL - это производственный процесс (проектирование, утверждение, заготовка деталей и т. Д.).Каждый столбец представляет собой объединенную ячейку, эквивалентную 7 строкам.Это будет заполнено "p" для текущего и заполнит желтый через правило, или будет заполнено "c" и заполнит зеленый через правило.

** L является наиболее важнымВ столбце «Завершение», когда ячейка для каждого проекта заполняется буквой «c», когда вы нажимаете кнопку обновления, я хочу, чтобы вся эта строка (по существу 7 строк), переместилась на другой лист с именем «2019_Completed_Orders» и удалила его из «Open_Orders».

Мой текущий код перемещает строку, когда L помечен буквой "c", но занимает только верхнюю строку из 7 строк.То есть он принимает «Имя клиента», но оставляет остальные.

Кроме того, строки в «2019_Completed_Orders» не следуют одна за другой, они сохраняются друг над другом.

Sub Completed()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Open_Orders").UsedRange.Rows.Count
    J = Worksheets("2019_Completed_Orders").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("2019_Completed_Orders").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Open_Orders").Range("L1:L" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "c" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("2019_Completed_Orders").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "c" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...