VBA для динамической фильтрации столбца Excel

Question

Я пытаюсь написать макрос для правила.

A   B   C   D   E

X   1   RT  YY  SOW  
D   3   FT  GH  TOW  
F   4   FG  TY  

Правило: фильтруйте по столбцу E один за другим и копируйте значение в столбцы A и C. Значение в столбце E не предопределено. Таким образом, у меня может быть Excel с другими значениями в столбце E, и, следовательно, я не могу жестко задавать критерии моего фильтра.

Я хочу фильтровать по первому значению (например, сеять), а затем по полученным строкам я копирую значение столбца E в столбцы A и C для этих строк. Затем я фильтрую второе значение (пример буксировки) и копирую его в столбцы A и C.

Результат должен выглядеть следующим образом

A     B    C   D   E

SOW   1   SOW  YY  SOW  
TOW   3   TOW  GH  TOW  
F     4   FG   TY  

Примечание: теперь, конечно, будут сотни строк, а не одна строка. и, следовательно, необходимость в макросе.

Уточнение : Я хочу взять все, кроме пробелов, из столбца E и скопировать в соответствующие строки в столбцах A и C. Но поскольку столбец E не имеет строго определенных значений, я не могу код мой критерий фильтра. Столбец E может иметь различное количество уникальных значений и комбинаций. И я хотел бы взять значения без пробелов и скопировать в столбцы A и C.

Answer 1

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

Код VBA:

Sub CopyNoneEmptyCells()

Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet1") 'Define your worksheet name
Dim lrow As Long
Dim i As Long


lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row 'Check last row in column A 'Find the last row in column A

For i = 2 To lrow 'Loop from row 2 until last row. I assume you have a header at row 1
    If ws.Cells(i, 5).Value <> "" Then 'If cell is not empty in column E, then
         ws.Cells(i, 1).Value =  ws.Cells(i, 5).Value 'Copy value from column E to Column A
         ws.Cells(i, 3).Value =  ws.Cells(i, 5).Value 'Copy value from column E to Column C
    End If
Next i 'Next row
End Sub