删除行如果列K：R全包含空白VBA的Excel

位背景的：我想要一台从“创建表” N2复制：AE14删除行如果列K：R全包含空白VBA的Excel

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

可能有人请帮助我或者：
一）复制和粘贴值减去跨越所有的空白
b）或帮我删除行的更快的方法。？

来源

2017-03-05 Shawn Cartwright

你写了_“如果列K：R都包含空白”_，但是你的代码（如果修剪（范围（“B”＆i）.Value）=“”和修剪（范围（“B”＆i）.Value）=“”然后'检查列“B”空单元格：你真正需要什么？ – user3598756

假设

要删除

“一整行的 ”样本数据“，如果列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-05 18:09:05 user3598756

@Shawn Cartwright，如果我的答案解决了您的问题，请点击答案旁边的复选标记以接受它，将其从灰色变为灰色。谢谢 – user3598756

@ShawnCartwright，有机会从您那里获得反馈？ – user3598756

奇妙的这是一种享受。唯一的问题是我按降序排序，然后在顶部一行旁边的列中添加超链接。你能帮忙吗？公用Sub超链接（）昏暗的路径作为字符串 “创建上的作业号工作表（‘样品数据’）的超级链接，选择路径= ThisWorkbook.Path＆‘\ PDF文件样本\’＆范围（“B2 “）＆” - “＆Range（”H2“）＆”.pdf“ 工作表（”示例数据“）Hyperlinks.Add Anchor：= Range（”C2“），Address：= Path，TextToDisplay：=”File “ 结束子 –

删除行如果列K：R全包含空白VBA的Excel

回答

相关问题