将具有特定值的所有单元格复制到跳过空白的另一列中

Question

我有三列，A，B和C：
A列包含名称，NAME1，NAME2等 B列仅包含值“YES”或“NO” C列假设包含A列中名称在B列中具有值“YES”的名称。

我可以说，只要B列中的值为“YES”，就将值从A列复制到C列。非常简单：

C1=IF(B1="YES",A1,"")

但这将包括空白单元格，我不想这样做。所以我想我正在寻找一种方法来复制A列中的所有名称，在B列中使用值“YES”，并将它们粘贴到C列中，跳过空白。

我确实找到了一个VBA项目，它使列中的所有单元格都具有特定值。我不知道如何将其编辑成我需要的东西。这是我到目前为止提出的代码。

问题
1）运行时错误'1004'应用程序定义或对象定义错误
2）从A列复制
3）检查并删除NewRange中的重复项

编辑1 ：在代码中添加了注释行 编辑2 ：使用偏移更改要从A列进行的NewRange（由于运行时错误而未经测试）
编辑3 ：用于复制的代码，从用于粘贴到另一张纸的代码中分离出一张纸 编辑4 ：从用户@abahgat添加更正 编辑5 ：删除重复项

Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1

'--> Loop through each cell in column B
'--> Add each cell in column A with value "YES" in column B to NewRange 
For Each cell In Worksheets("Sheet1").Range("B1:B30")
    If cell.Value = "YES" Then
        If MyCount = 1 Then Set NewRange = cell.Offset(0,-1)
        Set NewRange = Application.Union(NewRange, cell.Offset(0,-1))
        MyCount = MyCount + 1
    End If
Next cell

'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=activesheet.Range("C1")

'--> Remove Duplicates
activesheet.Range("C1:C30").RemoveDuplicates

End Sub

Answer 1

没有VBA的解决方案：

列C包含如下公式：

=COUNTIF(B$1:B1;"yes")

如果该行在B列中具有“是”值，则

增加C列中的数字。
该值将在下一步中使用。

列D包含如下公式：

=INDEX(A:A;MATCH(ROW();C:C;0))

取值：
表：整个A行
行号：由匹配函数计算：在整个C列中查找行号的第一次出现（我们将值放置的行号）。 0 meens，我们正在寻找这个数字而不是最接近的。

跳过错误：

=IF(ISERROR(MATCH(ROW();C:C;0));"";INDEX(A:A;MATCH(ROW();C:C;0)))

更容易写：

=IFERROR(INDEX(A:A;MATCH(ROW();C:C;0));"")

这意味着： 如果此值不是错误，则从规则写入值;如果规则是错误，则写入空字符串

Answer 2

在And上使用了If条件，以避免空单元格

1. 在C1中，然后将=IF(AND(LEN(A1>0),B1="YES"),A1,NA()))
复制下来
2. 选择column C
   • 按F5
   • 特殊 ...检查Formulas然后勾选错误（参见图片）
   • 删除所选单元格，在C列
   中留下较短的所需名称列表

Answer 3

这样可以解决问题：

Sub RangeCopyPaste()
  Dim cell As Range
  Dim NewRange As Range
  Dim MyCount As Long
  MyCount = 1

  For Each cell In Worksheets("Sheet1").Range("B1:B30")
      If cell.Value = "YES" Then
          If MyCount = 1 Then Set NewRange = cell.Offset(0,-1)
          Set NewRange = Application.Union(NewRange, cell.Offset(0,-1))
          MyCount = MyCount + 1
      End If
  Next cell

  NewRange.Copy Destination:=activesheet.Range("D1")

End Sub