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

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

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

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 2

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

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

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

Answer 3

实际上几年前我自己写了这样一个脚本，因为很多分析工具都会像那样导出信息到 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