将具有一定值的所有单元格复制到另一列跳过空格 [英] Copy all cells with certain value into another column skipping blanks

问题描述

我有三列A，B和C：

列A包含名称NAME1，NAME2等。

列B只包含值YES或 NO。

列C假设包含列B中名称为YES的列A。

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

  C1 = IF（B1 =YES，A1，）
  

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

我找到了一个VBA项目，它将一列中的所有单元格以一定的值进行着色。我不知道如何将它编辑成我需要的。这是我到目前为止的代码。

ISSUES

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 
 
' - >循环通过列B中的每个单元格
' - >将列B中的每个单元格添加到列B中的值为YES到NewRange 
对于工作表（Sheet1）中的每个单元格范围（B1：B30）
如果cell.Value =YES 然后
如果MyCount = 1然后设置NewRange = cell.Offset（0，-1）
设置NewRange = Application.Union（NewRange，cell.Offset（0，-1））
 MyCount = MyCount + 1 
 End If 
下一个单元格
 
' - >将NewRange从非活动工作表复制到活动工作表
 NewRange.Copy目标：= activesheet.Range（C1）
 
' - >删除重复
 activesheet.Range（C1：C30）。RemoveDuplicates 
 
 End Sub 
  

解决方案

这将是诀窍：

  Sub RangeCopyPaste ）
 Dim cell As Range 
 Dim NewRange As Range 
 Dim MyCount As Long 
 MyCount = 1 
 
对于Worksheets（Sheet1）中的每个单元格.Range（B1：B30）
如果cell.Value =YES然后
如果MyCount = 1然后设置NewRange = cell.Offset（0，-1）
设置NewRange = Application.Union（NewRange，cell.Offset（0，-1））
 MyCount = MyCount + 1 
 End If 
下一个单元格
 
 NewRange.Copy目标： = activesheet.Range（D1）
 
 End Sub 
  

I have three columns, A, B and C:
Column A contains names, NAME1, NAME2, etc.
Column B contains only the values "YES" or "NO".
Column C is suppose to contain the names from column A that have value "YES" in column B.

I can say that as long as the value is "YES" in column B, copy the value from column A to column C. Very simple with:

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

But this will include blank cells, which I don't want to. So I guess I am looking for a way to copy all the names from column A with value "YES" in column B and paste them into column C skipping the blanks.

I did find a VBA project that colors all the cells within a column with a certain value. I am not sure how to edit this into what I need. Here is the code I came up with so far.

ISSUES
1) Runtime Error '1004' Application-defined or Object-defined error
2) Copying from Column A
3) Check and Remove Duplicates from NewRange

EDIT 1: Added comment rows into the code
EDIT 2: Change NewRange to be made from column A with Offset (untested due to runtime error)
EDIT 3: Code for copying form one sheet separated from code for pasting into another sheet
EDIT 4: Added correction from user @abahgat
EDIT 5: Remove duplicates

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

解决方案

This will do the trick:

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

这篇关于将具有一定值的所有单元格复制到另一列跳过空格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！