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

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了Excel vba - 范围变化时如何复制/粘贴相关的知识,希望对你有一定的参考价值。

得到一张7000行的工作表。数据在A-C列中。 A列是团队,B是人,C是城镇。第1行包含标题。 Cell A2是第一个团队名称。单元格B2:C23是人和城镇(没有空单元格)。但是,单元格A3:A23是空的。团队名称仅针对第一排人/城镇写出。

第24行是空白的。在A25中有一个新的团队名称。 B25:C38是人/镇。 A26:A38是空的。

我想要做的是将A2中的团队名称复制/粘贴到A3:A23中的空单元格。然后在A25到A26:A38中使用团队名称。对于370支球队来说大约7000行。

但是每个团队使用的行数各不相同,那么VBA如何将其考虑在内呢?唯一固定的信息是每个团队/人/城镇之间有一个空行。

答案

我提出了一个考虑空白行的快速解决方案:

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
另一答案

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

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

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

另一答案

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

选择要处理的范围,即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 - 范围变化时如何复制/粘贴的主要内容,如果未能解决你的问题,请参考以下文章

Excel VBA - 循环遍历多个文件夹中的文件,复制范围,粘贴到此工作簿中

无法粘贴 - Excel VBA

从 Google 表格复制特定范围并将值粘贴到 excel

在 Excel 中使用 VBA,如何在 Outlook 中粘贴表格然后将表格转换为文本?

Excel VBA 将范围复制到 1,048,576 行后的新工作表

如何防止excel关闭复制选框