删除行如果列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)或帮我删除行的更快的方法。?
假设
- 要删除
“一整行的 ”样本数据“,如果列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
@Shawn Cartwright,如果我的答案解决了您的问题,请点击答案旁边的复选标记以接受它,将其从灰色变为灰色。谢谢 – user3598756
@ShawnCartwright,有机会从您那里获得反馈? – user3598756
奇妙的这是一种享受。唯一的问题是我按降序排序,然后在顶部一行旁边的列中添加超链接。你能帮忙吗? 公用Sub超链接() 昏暗的路径作为字符串 “创建上的作业号 工作表(‘样品数据’)的超级链接,选择 路径= ThisWorkbook.Path&‘\ PDF文件样本\’&范围(“B2 “)&” - “&Range(”H2“)&”.pdf“ 工作表(”示例数据“)Hyperlinks.Add Anchor:= Range(”C2“),Address:= Path,TextToDisplay:=”File “ 结束子 –
你写了_“如果列K:R都包含空白”_,但是你的代码(如果修剪(范围(“B”&i).Value)=“”和修剪(范围(“B”&i).Value)=“”然后'检查列“B”空单元格:你真正需要什么? – user3598756