Подскажите, пожалуйста, как улучшить поиск столба

Автор Посетитель, 25 сентября 2022, 06:57

Посетитель

Здравствуйте. Есть вот такой код:
Спойлер
Sheets("z").Select
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, i) = "ad" Then
  L = i: Exit For
End If
Next
Columns(L).Select
Selection.Copy
Sheets("v").Select
Columns("A:A").Select
ActiveSheet.Paste
[свернуть]

С одного листа макрос копирует найденный столбец "ad". Нюанс в том, что в исходной таблице (не знаю кого хвалить за это) два столбца с таким именем. Один полностью пустой, а другой может быть или полностью заполнен или частично - при этом в строке 2 может быть пусто, а в строке 3 может быть значение, т.е. столбец не заполняется сверху вниз, а заполняет хаотично.
По порядку чаще всего находится и копируется пустой. Подскажите, пожалуйста, куда курить. Готовых решений не прошу. Спасибо)

Администратор

Если у столбца заголовок "ad", то можно посмотреть, что находится во второй строке. Если она пустая, можно сделать вывод, что столбец пустой.
Вместо переменной "i", лучше использовать "j", т.к. переменная "i" используется для движения по строкам, а переменная "j" используется для движения по столбцам.

Макрос
Sub Макрос()
   
    Sheets("z").Select
    For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
        If Cells(1, j) = "ad" Then
            If Cells(2, j).Value <> "" Then
                L = j: Exit For
            End If
        End If
    Next
    Columns(L).Select
    Selection.Copy
    Sheets("v").Select
    Columns("A:A").Select
    ActiveSheet.Paste

End Sub
[свернуть]

Посетитель

Здравствуйте! Попоробовал сам, но умов для этого не хватает) Подскажите, пожалуйста, как оптимизировать код под условие, что один столбец полностью пустой, а авторой из раза в раз забит по-разному. Полагаю, нужно выполнить проверку по количеству заполненных строк, но как - не хватает смекалки( Спасибо!

Администратор

Макрос
Sub Макрос()
   
    Sheets("z").Select
    For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
        If Cells(1, j) = "ad" Then
            If WorksheetFunction.CountA(Columns(j)) <> 1 Then
                L = j: Exit For
            End If
        End If
    Next
    Columns(L).Select
    Selection.Copy
    Sheets("v").Select
    Columns("A:A").Select
    ActiveSheet.Paste

End Sub
[свернуть]

Посетитель