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
Copy all cells with certain value into another column skipping blanks
提问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 And
condition on your If
to avoid the empty cells
刚刚使用了一个And
条件If
来避免空单元格
- In
C1
, put then copy down=IF(AND(LEN(A1>0),B1="YES"),A1,NA()))
- Select
column C
- Press F5
- Special... check
Formulas
and then tick Errors(see pic) - Delete the selected cells, to leave you with a shorter list of desired names in column C
- 在
C1
,放然后复制下来=IF(AND(LEN(A1>0),B1="YES"),A1,NA()))
- 选择
column C
- 按F5
- 特殊......检查
Formulas
然后勾选错误(见图) - 删除选定的单元格,在 C 列中留下所需名称的较短列表