Автор Тема: Подскажите, пожалуйста, как улучшить поиск столба  (Прочитано 576 раз)

Оффлайн Посетитель 25.09.2022

  • Посетитель форума
  • Сообщений: 3
Здравствуйте. Есть вот такой код:
Спойлер
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 может быть значение, т.е. столбец не заполняется сверху вниз, а заполняет хаотично.
По порядку чаще всего находится и копируется пустой. Подскажите, пожалуйста, куда курить. Готовых решений не прошу. Спасибо)

Оффлайн Администратор

  • Administrator
  • Сообщений: 2162
Если у столбца заголовок "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

Оффлайн Посетитель 25.09.2022

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

Оффлайн Администратор

  • Administrator
  • Сообщений: 2162
Макрос
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

Оффлайн Посетитель 25.09.2022

  • Посетитель форума
  • Сообщений: 3
Спасибо! Заработало!)