vba - 在VBA的列中选择可变的空白单元格范围
问题描述
我有一个代码,其中包含整个特定列的空白单元格。我希望能够选择仅空白单元格的未知长度(偏移 2 列)。我目前有多个根据空格数过滤的 if 语句,但可变的空格数可能会使这变得过于复杂。
示例:当遇到这两个空白(6 和 7)时,我想将这些行(6 和 7)的右侧两列内容连接起来,并粘贴到上面的单元格和修订版右侧的一列/评论/空白(然后我删除修订/评论的行,所以在这里,6 和 7 被删除)。我已经弄清楚了这部分,如图1到2所示。
这些空白单元格在整个过程中随机出现并且长度可变,有时没有修订/评论,有时是两行,五行等......
因此,与其有很多 if 语句来说明有多少行是修订/注释,我正在寻找可以选择任何可变长度的空白单元格并将该信息全部传输到一个单元格的代码(直接位于原始单元格右侧的那个)信息线)。
到目前为止,这是我的代码的一部分:
Sub BlankCell()
'Delete all header rows (except top row)
Dim i, LastRow As Integer
i = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
Do While i <= LastRow
If Cells(i, 2).Value = "Line" Then
Rows(i).EntireRow.Delete
End If
i = i + 1
Loop
'Select first cell
Range("C2").Select
'Loop through column C to find empty cells
'Copy and paste column E contents (concatenated) to column F and delete row(s) of clarifications
Do While Not IsEmpty("C")
'If there are three rows of comments
If IsEmpty(ActiveCell.Offset(1, 0)) And IsEmpty(ActiveCell.Offset(2, 0)) Then
Range(ActiveCell.Offset(0, 2), Range(ActiveCell.Offset(1, 2), ActiveCell.Offset(2, 2))).Select
ActiveCell.Offset(-1, 1) = ActiveCell.Offset(0, 0).Value & Chr(10) & ActiveCell.Offset(1, 0).Value & Chr(10) & ActiveCell.Offset(2, 0).Value
Selection.EntireRow.Delete
'If there are two rows of comments
ElseIf IsEmpty(ActiveCell.Offset(1, 0)) Then
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(1, 2)).Select
ActiveCell.Offset(-1, 1) = ActiveCell.Offset(0, 0).Value & Chr(10) & ActiveCell.Offset(1, 0).Value
Selection.EntireRow.Delete
'If there is one row of comments
Else
ActiveCell.Offset(0, 2).Select
ActiveCell.Offset(-1, 1) = ActiveCell.Offset(0, 0).Value
Selection.EntireRow.Delete
End If
'Find next blank in column C
NextBlank = Range("C1:C" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
Range("C" & NextBlank).Select
'Exit loop once to the end of the table
If IsEmpty(ActiveCell.Offset(0, -1)) And IsEmpty(ActiveCell.Offset(1, -1)) Then
Exit Do
End If
Loop
End Sub
提前致谢!
解决方案
尝试这个。图片显示了之前和之后,因此您可以检查它是否正确。您可能需要调整详细信息以进行精确设置。
这使用 SpecialCells 循环遍历空白区域并在删除区域(空单元格的连续块)之前连接相应的单元格。
Sub BlankCell()
Dim j As Long, s As String, r As Range
With Columns("C").SpecialCells(xlCellTypeBlanks)
For j = .Areas.Count To 1 Step -1
For Each r In .Areas(j)
s = s & r.Offset(, 1) & vblf
Next r
.Areas(j)(1).Offset(-1, 2) = Trim(s)
s = vbNullString
.Areas(j).EntireRow.Delete
Next j
End With
End Sub
前
后
推荐阅读
- django - Django,修改模型管理器的初始查询集有什么好处?
- angular - md-tab中的Angular SlickGrid动态网格未加载定义
- r - 删除主要 y 轴标签和刻度,同时保留辅助 y 轴的标签和刻度
- c# - 为什么我的重置高分的重置代码不起作用?
- sql - 在表“Y”上引入 FOREIGN KEY 约束“X”可能会导致循环或多个级联路径
- php - 检测 PHP 生成器是否接受 send()?
- flutter - 如何在不显示所选值的情况下创建下拉按钮
- r - R:使用数据屏蔽函数/tidyverse 引用之前在同一自定义函数中创建的列
- c - 为什么静态变量只能用常量字面量初始化?
- c++ - Windows 7 Embedded - 以编程方式禁用磁盘缓存: