Question

拿一张可容纳7000行的纸。数据在A-C列中。列A是团队，B是人员，C是城镇。第1行包含标题。单元格A2是第一个团队名称。单元格B2：C23是个人和城镇（无空单元格）。但是，单元格A3：A23为空。团队名称仅写在第一行人员/城镇中。

第24行为空白。在A25中，有一个新的队名。 B25：C38是个人/城镇。 A26：A38是空的。

我想要做的是将A2中的团队名称复制/粘贴到A3中的空白单元格：A23。然后对A25到A26：A38中的团队名称执行相同的操作。依此类推，大约有370支球队的7000行。

但是每个团队使用的行数不同，因此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

实际上，几年前我就自己编写了这样的脚本，因为许多分析方法都将出口信息推向了如此出色的境地

选择要处理的范围，即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

Excel VBA-范围变化时如何复制/粘贴

3 个答案: