vba Excel 表达式复制行但删除空白行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/23013461/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel expression to copy rows but remove blank rows
提问by John Livermore
I need to copy data from one worksheet into another. However, I need a conditional copy operation that will skip rows based on criteria.
我需要将数据从一个工作表复制到另一个工作表中。但是，我需要一个条件复制操作，它将根据条件跳过行。
For example, if I start with...
例如，如果我开始...
Active Value
yes 1
no 2
no 3
yes 4
no 5
no 6
I only want to copy rows that are Active=yes, so I would end up with...
我只想复制 Active=yes 的行，所以我最终会......
Value
1
4
Can someone show me how this is done with 1) a macro and 2) a formula?
有人可以告诉我这是如何使用 1) 宏和 2) 公式完成的吗？
回答by Dmitry Pavliv
Formula approach:
公式方法：
suppose your data are in sheet1, range A2:B7.
假设您的数据在 sheet1, range 中A2:B7。
Then use this formula in sheet2 cell A2:
然后在 sheet2 单元格中使用此公式A2：
=IFERROR(INDEX(Sheet1!B:B,SMALL(IF(Sheet1!$A:$A="yes",ROW(Sheet1!$A:$A)),ROW()-ROW($A)+1)),"")
with array entry (CTRL+SHIFT+ENTER) and then drag it down.
与阵列条目（CTRL+ SHIFT+ ENTER），然后将其向下拖动。
VBA approach:
VBA方法：
You can use AutoFilter:
您可以使用自动过滤器：
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheet1 and Sheet2 to suit
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
With ws1
'assumung that your data stored in column A:B, Sheet1
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A1:B" & lastrow)
'clear all filters
.AutoFilterMode = False
With rng
'apply filter
.AutoFilter Field:=1, Criteria1:="yes"
On Error Resume Next
'get only visible rows
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'copy range
If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws2.Range("A1")
'clear all filters
.AutoFilterMode = False
End With
Application.CutCopyMode = False
End Sub
Note, if you want to copy only Valuecolumn, change
请注意，如果您只想复制Value列，请更改
Set rngToCopy = .SpecialCells(xlCellTypeVisible)
to
到
Set rngToCopy = .Offset(, 1).Resize(, .Columns.Count - 1).SpecialCells(xlCellTypeVisible)
回答by tmoore82
It's easy enough with a macro. Assuming you're copying from the first sheet to the second sheet, and that your sample above is in columns A and B, you could do the following:
使用宏很容易。假设您要从第一张纸复制到第二张纸，并且上面的示例位于 A 列和 B 列中，您可以执行以下操作：
Public Sub ConditionalCopy()
Dim copyRng As Range
Set copyRng = Worksheets(1).Range("B2:B7")
Dim pasteRng As Range
Set pasteRng = Worksheets(2).Range("A2")
Dim i As Long
i = 0
For Each cell in copyRng.Cells
If cell.Offset(0, -1).Value2 = "yes" Then
pasteRng.Offset(i,0).Value2 = cell.Value2
i = i + 1
End If
Next cell
End Sub
Doing it with a formula presents a challenge in terms of not leaving any blank rows on the second sheet. It would be pretty trivial to just use the following in the second sheet:
在第二张纸上不留下任何空白行方面，使用公式进行操作是一项挑战。在第二张表中仅使用以下内容将非常简单：
=If(A2 = "yes",b2,"")
And copy that down, but you're going to end up with blank rows that you'll have to go back and delete yourself. If you have the ability to use the macro, it's straightforward enough that I would go that route rather than sinking too much effort into devising a formula. The more I think about it, the more I feel like it has to be a programmatic solution to avoid double references.
把它复制下来，但你最终会得到空白行，你必须返回并删除自己。如果你有能力使用宏，那么我会走那条路，而不是花太多精力去设计一个公式，这很简单。我想得越多，我就越觉得它必须是一种避免双重引用的程序化解决方案。
回答by russjoliver
If you use seperate counters for the source and destination rows, and use cell references rather than ranges the following routine should do the trick
如果您对源行和目标行使用单独的计数器，并使用单元格引用而不是范围，则以下例程应该可以解决问题
Public Sub copyactivevalue()
Dim i As Integer
Dim j As Integer
Dim acts As Excel.Worksheet
Dim news As Excel.Worksheet
Set acts = Excel.Worksheets("sheet1")
Set news = Excel.Worksheets("sheet2")
With acts
j = 2
For i = 2 To 7
If acts.Cells(i, 1).Value = "yes" Then
news.Cells(j, 1) = acts.Cells(i, 2).Value
j = j + 1
End If
Next
End With
Set acts = Nothing
Set news = Nothing
End Sub
Hope this helps
希望这可以帮助
