0

一点背景：我正在尝试从“创建表单”N2：AE14 复制表格

Set r = Sheets("Create Form").Range("COPYTABLEB")
Selection.Copy

Set dest = Sheets("Sample Data").Range("B1").End(xlDown).Offset(1, 0)     
r.Copy
dest.PasteSpecial Paste:=xlPasteValues

我希望它只复制具有值而不是空白的单元格，但不幸的是它正在拾取公式并将它们粘贴为空白。因此，当我粘贴下一部分时，它会将空白视为数据。

因此，如果 K:R 列在被复制后都包含空白，我试图找出一种方法来删除“示例数据”中的整个行。

我目前有一个循环来处理 B 列空白，但它需要的时间太长了。

Lastrow = Range("B" & Rows.Count).End(xlUp).Row
MsgBox (Lastrow)
For i = Lastrow To 2 Step -1
If Trim(Range("B" & i).Value) = "" And Trim(Range("B" & i).Value) = "" Then
Range("B" & i).EntireRow.Select
Selection.Delete

End If

Next i

有人可以帮助我吗：
a.）复制并粘贴减去所有空格的值
b.）或帮助我更快地删除行？

4

1 回答 1

0

假设

  • 你想删除

“如果列 K:R 都包含空白，则“样本数据”中的一整行”

你可以试试这个：

Sub CopyValuesAndDeleteRowsWithBlankKRColumns()
    Dim pasteArea As Range
    Dim iRow As Long

    With Sheets("Create Form").Range("COPYTABLEB")
        Set pasteArea = Sheets("Sample Data").Range("B" & Rows.count).End(xlUp).Offset(1, 0).Resize(.Rows.count, .Columns.count)
        pasteArea.Value = .Value
    End With
    With Intersect(pasteArea, Sheets("Sample Data").Range("K:R"))
        For iRow = .Rows.count To 1 Step -1
            MsgBox WorksheetFunction.CountBlank(.Rows(iRow)) & " - " & WorksheetFunction.CountBlank(.Rows(iRow)) Mod 8
            If WorksheetFunction.CountBlank(.Rows(iRow)) Mod 8 = 0 Then .Rows(iRow).EntireRow.Delete
        Next
    End With
End Sub
于 2017-03-05T18:09:05.523 回答