5

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

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

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

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

我确实找到了一个 VBA 项目，它用特定的值为列中的所有单元格着色。我不确定如何将其编辑为我需要的内容。这是我到目前为止提出的代码。

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

编辑 1：在代码中添加了注释行
编辑 2：将 NewRange 更改为从具有偏移量的 A 列（由于运行时错误而未测试）
编辑 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
4

3 回答 3

6

没有 VBA 的解决方案：

C列包含如下公式：

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

如果该行在 B 列中具有“是”值，则增加 C 列中的数字。
该值将在下一步中使用。

D列包含如下公式：

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

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

跳过错误：

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

更容易写：

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

这意味着：如果该值不是错误，则写入规则中的值；如果规则错误，则写入空字符串

于 2013-07-18T09:05:33.493 回答
2

只是And对你使用了一个条件If来避免空单元格

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

在此处输入图像描述

于 2012-11-20T09:40:17.197 回答
1

这可以解决问题：

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
于 2012-11-23T14:22:39.917 回答