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

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/13470007/
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

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 14:27:40  来源:igfitidea点击:

Copy all cells with certain value into another column skipping blanks

excelexcel-vbaskipvba

提问by Ampi Severe

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.

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

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:

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

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.

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

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.

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

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

问题
1)运行时错误“1004”应用程序定义或对象定义错误
2)从 A 列复制
3)检查并删除 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

编辑 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

采纳答案by abahgat

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

回答by user2594042

Solution without VBA:

没有VBA的解决方案:

column C contains formulas like:

C列包含以下公式:

=COUNTIF(B:B1;"yes")

increase number in column C if this row has "yes" value in column B.
This value will by used in next step.

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

column D contains formulas like:

D 列包含以下公式:

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

take value from:
table: an entire A row
row number: calculated by match function: find first occurance of row number (row number where we will place the value) in entire C column. 0 meens that we looking for exactly this number not an clossest.

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

to skip errors:

跳过错误:

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

easier can be writen:

可以写得更简单:

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

and this means: write the value from rule if this value is not an error or write empty string if the rule is an error

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

回答by brettdj

Just used a Andcondition on your Ifto avoid the empty cells

刚刚使用了一个And条件If来避免空单元格

  1. In C1, put then copy down =IF(AND(LEN(A1>0),B1="YES"),A1,NA()))
  2. Select column C
    • Press F5
    • Special... check Formulasand then tick Errors(see pic)
    • Delete the selected cells, to leave you with a shorter list of desired names in column C
  1. C1,放然后复制下来=IF(AND(LEN(A1>0),B1="YES"),A1,NA()))
  2. 选择 column C
    • 按F5
    • 特殊......检查Formulas然后勾选错误(见图)
    • 删除选定的单元格,在 C 列中留下所需名称的较短列表

enter image description here

在此处输入图片说明