Excel vba - Как копировать / вставлять, когда диапазон варьируется

Question

Получил лист, содержащий 7000 строк.Данные в столбцах AC.Столбец A - это команды, B - люди, а C - города.Строка 1 содержит заголовки.Cell A2 - это первое название команды.Ячейка B2: C23 - это люди и города (без пустых ячеек).Однако ячейка A3: A23 пуста.Название команды записывается только для первого ряда людей / городов.

Строка 24 пуста.В А25 появилось новое название команды.B25: C38 это люди / города.A26: A38 пусто.

Я хочу скопировать / вставить название команды в A2, чтобы пустые ячейки в A3: A23.И затем сделайте то же самое с названием команды от A25 до A26: A38.И так далее примерно на 7000 строк для 370 команд.

Но количество строк, используемых для каждой команды, варьируется, так как VBA может принять это во внимание?Единственная фиксированная информация - пустая строка между каждой командой / человеком / городом.

Answer 1

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

=IF(B2<>"",IF(A2="",D1,A2),"")

Затем скопируйте столбец D и вставьте значения в столбец A.

Answer 2

Я нашел быстрое решение, которое учитывает пустые строки:

Option Explicit

Sub completeTeams()
    Dim i As Long
    Const startDataRow = 2
    Dim lastDataRow As Long
    Dim lastTeamRow As Long

    Dim lastTeamFound As String
    Dim teamCellData As String

    Dim isEmptyLine As Boolean

    Rem getting the last row with data (so using column B or C)
    lastDataRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row

    teamCellData = vbNullString
    lastTeamFound = ActiveSheet.Cells(startDataRow, "A").Text

    For i = startDataRow To lastDataRow
        Rem trying to get the actual team name
        teamCellData = ActiveSheet.Cells(i, "A").Text

        Rem check to skip empty lines
        isEmptyLine = Len(teamCellData) = 0 And Len(ActiveSheet.Cells(i, "B").Text) = 0
        If isEmptyLine Then GoTo skipBlankLine

        If Len(teamCellData) > 0 Then
            lastTeamFound = teamCellData
        End If

        ActiveSheet.Cells(i, "A").Value = lastTeamFound

skipBlankLine:
    Next

End Sub

Answer 3

Фактически написал такой скрипт myselft несколько лет назад, так как многие аналитики платят за экспорт информации, чтобы добиться такого превосходства

Выберите диапазон, над которым вы хотите работать, то есть A1: A7000, и запустите скрипт:

Sub fill2()
 Dim cell As Object
 For Each cell In Selection
    If cell = "" Then cell = cell.OffSet(-1, 0)
 Next cell
End Sub