Код VBA для перемещения строки по критериям

Question

Я новичок в StackExchange и VBA, и я попытался найти ответ на этот вопрос, но у меня возникли проблемы !!!

У меня есть электронная таблица, на которой вводится информация и отображается в Листе 2, столбцах B-I. Мне бы хотелось, чтобы, если столбец H пуст, он перемещает всю строку в столбец L на S. Таким образом, мои данные будут разделены на 2 отдельных места на одном листе, исходя из того, пусто ли он или заполнено H.

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

Может ли кто-нибудь сказать мне, как этого достичь? Большое спасибо Бев

Answer 1

Попробуйте это за отправную точку

Option Explicit 
Const FIRST_ROW As Long = 2 
Const LAST_ROW As Long = 100 
Const FIRST_SOURCE_COL As Long = 2 'column B 
Const LAST_SOURCE_COL As Long = 9 'column I 
Const TRIG_COL As Long = 8 'column H 
Const GAP As Long = 2 'columns gap between original data and moved data 

Sub moveit() 
Dim r As Long 
Dim c As Long 
Const DIST As Long = LAST_SOURCE_COL - FIRST_SOURCE_COL + GAP + 1 

For r = FIRST_ROW To LAST_ROW 
    'check if we need to move 
    If Cells(r, TRIG_COL).Value = "" Then 
    'move the data 
     For c = FIRST_SOURCE_COL To LAST_SOURCE_COL 
      Cells(r, c + DIST).Value = Cells(r, c).Value 
      Cells(r, c).Value = "" 
     Next 
    End If 
Next 
End Sub 

Answer 2

Перемещение заготовки,

Sub MoveBlanks() 
    Dim lRws As Long, sh As Worksheet, x 

    Set sh = Sheets("Sheet2") 

    With sh 
     lRws = .Cells(.Rows.Count, "B").End(xlUp).Row 
     For x = lRws To 2 Step -1 
      If .Cells(x, "H") = "" Then 
       .Range(.Cells(x, "B"), .Cells(x, "I")).Cut .Cells(.Rows.Count, "L").End(xlUp).Offset(1) 
       .Range(.Cells(x, "B"), .Cells(x, "I")).Delete Shift:=xlUp 
      End If 
     Next x 
    End With 

End Sub 

Перед

После