Excel vba - 如何在范围变化时 copy/paste

Excel vba - How to copy/paste when range varies

得到一个 sheet 包含 7000 行。数据位于 A-C 列中。 A 列是团队,B 列是人员,C 列是城镇。第 1 行包含 headers。 单元格 A2 是第一个团队名称。单元格 B2:C23 是人员和城镇(没有空单元格)。但是,单元格 A3:A23 为空。队名只写在persons/towns的第一行。

第 24 行为空白。 A25中有一个新的队名。 B25:C38 是 persons/towns。 A26:A38为空

我想做的是 copy/paste 将 A2 中的团队名称缩减为 A3 中的空单元格:A23。然后将A25至A26中的队名同理:A38。依此类推,370 个团队的大约 7000 行。

但是每个团队使用的行数各不相同,那么 VBA 如何考虑到这一点? 唯一固定的信息是每个 team/person/town-section 之间有一个空行。

实际上我自己几年前就写了这样一个脚本,因为很多分析工具都像那样将信息导出到excel

Select 您要处理的范围,即 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

如果您接受仅使用公式的方法,则可以将此公式添加到单元格 D2 并向下复制。

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

然后复制 D 列并将值粘贴到 A 列中。

我想到了一个考虑空行的快速解决方案:

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