Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
在VBA中的列中选择可变空白单元格范围_Vba_Excel - Fatal编程技术网

在VBA中的列中选择可变空白单元格范围

在VBA中的列中选择可变空白单元格范围,vba,excel,Vba,Excel,我有一个代码,在某一列中包含空白单元格。我希望能够选择未知长度的空白单元格(偏移量2列)。我目前有多个if语句,它们是根据空格的数量进行过滤的,但是空格的数量可变可能会使这太复杂 例如: 当它遇到这两个空格(6和7)时,我想连接这些行(6和7)的内容,右边的两列,粘贴在上面的单元格中,右边的一列粘贴在修订/注释/空格中(然后我删除修订/注释行,所以这里删除6和7)。我已经把这部分弄清楚了,从图到图 这些空白单元格在整个过程中随机出现,长度可变,有时没有修订/注释,有时两行、五行等 因此,我不是要

我有一个代码,在某一列中包含空白单元格。我希望能够选择未知长度的空白单元格(偏移量2列)。我目前有多个if语句,它们是根据空格的数量进行过滤的,但是空格的数量可变可能会使这太复杂

例如: 当它遇到这两个空格(6和7)时,我想连接这些行(6和7)的内容,右边的两列,粘贴在上面的单元格中,右边的一列粘贴在修订/注释/空格中(然后我删除修订/注释行,所以这里删除6和7)。我已经把这部分弄清楚了,从图到图

这些空白单元格在整个过程中随机出现,长度可变,有时没有修订/注释,有时两行、五行等

因此,我不是要用许多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
Sub BlankCell()
'删除所有标题行(顶行除外)
Dim i,最后一行为整数
i=2
LastRow=单元格.SpecialCells(xlCellTypeLastCell).Row

趁我试试这个。这些图片显示了之前和之后的内容,因此您可以检查它是否正确。您可能需要调整细节,以便进行精确设置

使用特殊单元循环空白区域并在删除区域(相邻空单元块)之前连接相应的单元格。

以前

之后

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