我在工作表中指定了一个范围,该范围宽五列,长约 220 行。 该范围内的行主要是从其他位置提取数据并连接或以其他方式操作它的公式。 该范围中的某些行由完全空白的单元格(无公式)组成,或者可能包含不返回值的公式。
空白行总是有一个解析为无值的公式,或者在其所有单元格中根本没有公式。当一行为空时,该行中的所有单元格都满足该条件,因此可以在第一列中的单元格上进行测试,但测试必须在计算公式的值之后进行(否则单元格中的公式将被评估为“非空白”)
我想复制该范围并粘贴公式返回的值,省略任何空白行,从第二个工作表的单元格 E5 开始。
下面的代码执行了我想要的操作,只是它不省略空白行:
Sub RangeRefactor()
Dim wsI As Worksheet
Dim wsO As Worksheet
Set wsI = ThisWorkbook.Sheets("InputSheet")
Set wsO = ThisWorkbook.Sheets("OutputSheet")
With Range("Refactor")
.Copy
wsO.Range("e5").PasteSpecial xlPasteValues
End With
End Sub
我不知道如何在范围位于内存中和粘贴之前删除空白行。 我审查过的大多数解决方案都使用了一些方法,我认为这些方法会在复制范围之前删除 InputSheet 中的行,这是不需要的(即 SpecialCells(xlCellTypeBlanks).Select / Selection.EntireRow.Delete)
答案可能是在粘贴之前必须将范围加载到数组中进行操作,但我希望有一个更简单的方法,因为我已经很长很长一段时间没有使用数组了。 感谢您的帮助!
主要
Sub CopyRefactor()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Sheets("InputSheet")
Dim srg As Range: Set srg = sws.Range("Refactor")
Dim dws As Worksheet: Set dws = wb.Sheets("OutputSheet")
Dim dcell As Range: Set dcell = dws.Range("e5")
CopyNonBlankRows srg, dcell
End Sub
帮助
Sub CopyNonBlankRows(ByVal srg As Range, dcell As Range)
Dim rCount As Long: rCount = srg.Rows.Count
Dim cCount As Long: cCount = srg.Columns.Count
Dim Data() As Variant
If rCount + cCount = 2 Then
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = srg.Value
Else
Data = srg.Value
End If
Dim sr As Long, c As Long, drCount As Long
For sr = 1 To rCount
For c = 1 To cCount
If Len(CStr(Data(sr, c))) > 0 Then Exit For
Next c
If c <= cCount Then
drCount = drCount + 1
For c = 1 To cCount
Data(drCount, c) = Data(sr, c)
Next c
End If
Next sr
dcell.Resize(drCount, cCount).Value = Data
End Sub