Vba 将包含特定值的单元格复制到另一列中，跳过空格
我在B列有一个问题列表，在C列有它们的相关状态。 我只想将状态为“准备测试”、“内置产品”、“进行中”或“等待CAB批准”的问题复制到D列，不希望中间有空白单元格 我稍微修改了本主题中的代码，但无法使其适用于四种不同的状态类型（我尝试添加ElseIf语句，但似乎不起作用）： 在此提前感谢您的帮助，我对Excel VBA非常陌生 更新日期：2017年6月2日 我已经创建了我的文件的简化版本，以演示我试图实现的目标。我的原始文件有许多选项卡，每个选项卡有更多的列和数百行。 （抱歉，它不允许我添加多个图像，因此我必须上传一个大图像） 表2-包含有关作业的所有详细信息 Sheet1-我希望这是仅显示活动工单的概览选项卡。A列包含表2中更改的超链接。如果复制单元格，F列的条件格式将被删除，因此我使用了VLOOKUP 当我从Tom或Scott运行原始脚本时（对D列和E列使用单独的循环），可以正确复制细节，但不会复制超链接。 当我运行新脚本时，列E被正确复制，但列D和F由于某种原因没有正确复制。 我认为原始脚本适用于列E，但对于列D，有没有保存超链接的方法？ 原稿Vba 将包含特定值的单元格复制到另一列中，跳过空格,vba,excel,Vba,Excel,我在B列有一个问题列表，在C列有它们的相关状态。 我只想将状态为“准备测试”、“内置产品”、“进行中”或“等待CAB批准”的问题复制到D列，不希望中间有空白单元格 我稍微修改了本主题中的代码，但无法使其适用于四种不同的状态类型（我尝试添加ElseIf语句，但似乎不起作用）： 在此提前感谢您的帮助，我对Excel VBA非常陌生 更新日期：2017年6月2日 我已经创建了我的文件的简化版本，以演示我试图实现的目标。我的原始文件有许多选项卡，每个选项卡有更多的列和数百行。 （抱歉，它不允许我添加多
Sub RangeCopyPaste()
Dim cell As Range
Dim NewChangeRange As Range
Dim NewDetailRange As Range
Set NewChangeRange = Range("D6") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
NewChangeRange.Value = cell.Offset(0, -2).Value 'In the destination cell, take the cell value 1 column to the left of the cell which contained the required status
Set NewChangeRange = NewChangeRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
Set NewDetailRange = Range("E6") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
NewDetailRange.Value = cell.Offset(0, -1).Value 'In the destination cell, take the cell value 1 column to the left of the cell which contained the required status
Set NewDetailRange = NewDetailRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
End Sub
Sub RangeCopyPaste()
Dim cell As Range
Dim NewChangeRange As Range
Dim NewDetailRange As Range
Set NewChangeRange = Range("D6") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
Range(cell.Offset(0, -2), cell.Offset(0, -2)).Copy NewChangeRange
Set NewChangeRange = NewChangeRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
Set NewDetailRange = Range("E6") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C6:C14") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
NewDetailRange.Value = cell.Offset(0, -1).Value 'In the destination cell, take the cell value 1 column to the left of the cell which contained the required status
Set NewDetailRange = NewDetailRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
End Sub
利用这里的
CaseSub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
'--> Loop through each cell in column C
'--> Add each cell in column B with value "Ready for Testing" in column B to
For Each cell In Worksheets("OverviewTest").Range("C6:C56")
Select Case cell.Value
Case is = "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval"
If MyCount = 1 Then
Set NewRange = cell.Offset(0, -1)
Else
Set NewRange = Application.Union(NewRange, cell.Offset(0, -1))
End If
MyCount = MyCount + 1
End Select
Next cell
'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("D6")
End Sub
利用这里的
CaseSub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Dim MyCount As Long
MyCount = 1
'--> Loop through each cell in column C
'--> Add each cell in column B with value "Ready for Testing" in column B to
For Each cell In Worksheets("OverviewTest").Range("C6:C56")
Select Case cell.Value
Case is = "Ready for Testing", "Build in Prod", "In Progress", "Awaiting CAB Approval"
If MyCount = 1 Then
Set NewRange = cell.Offset(0, -1)
Else
Set NewRange = Application.Union(NewRange, cell.Offset(0, -1))
End If
MyCount = MyCount + 1
End Select
Next cell
'--> Copy NewRange from inactive sheet into active sheet
NewRange.Copy Destination:=ActiveSheet.Range("D6")
End Sub
请尝试以下代码来解决您的问题
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Set NewRange = Range("D1") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C1:C16") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
NewRange.Formula = Range(cell.Offset(0, -2), cell.Offset(0, -2)).Formula 'Copies the formula from Column A
NewRange.Offset(0, 1).Value = Range(cell.Offset(0, -1), cell.Offset(0, -1)).Value ' Copies the value from Column B
NewRange.Offset(0, 2).Value = Range(cell).Formula ' Copies the formula from Column C
Set NewRange = NewRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
End Sub
请尝试以下代码来解决您的问题
Sub RangeCopyPaste()
Dim cell As Range
Dim NewRange As Range
Set NewRange = Range("D1") 'Set the first destination cell
For Each cell In Worksheets("Sheet1").Range("C1:C16") 'Loop through your Status column
Select Case cell.Value 'Select Case is an alternative to writing multiple If, ElseIf statements, particularly if you want it to run the same code when it is true.
Case "Ready for testing", "Build in Prod", "In Progress", "Awaiting CAB Approval" 'Specify all the values which would consitute a "True" result
NewRange.Formula = Range(cell.Offset(0, -2), cell.Offset(0, -2)).Formula 'Copies the formula from Column A
NewRange.Offset(0, 1).Value = Range(cell.Offset(0, -1), cell.Offset(0, -1)).Value ' Copies the value from Column B
NewRange.Offset(0, 2).Value = Range(cell).Formula ' Copies the formula from Column C
Set NewRange = NewRange.Offset(1, 0) 'Setup the new destination cell ready for the next "True" result
End Select
Next cell
End Sub
谢谢你的选择和有益的解释。如果C1中存在真实结果，是否可以修改上述代码以将A1、B1、C1复制到D1、E1、F1？当然可以。将“NewRange.Value=cell.Offset（0，-1）.Value”替换为Range（cell.Offset（0，-2），cell.Offset（0,3））。复制NewRange还将更改NewRange设置，因为它当前将覆盖数据。嗨，Tom，感谢您提供的新信息，但它与我尝试执行的操作不完全一致。我已经用截图更新了我的原始问题，因为我不能在这里添加它们。嗨，Brian，你的问题似乎是，当公式移动到D列时，超链接引用会发生变化，而不是有；行（）-4尝试执行匹配公式；匹配（B6，Sheet2！$B$2:$B$10,0）这意味着超链接仍然指向Sheet2上的正确行。对于F列，如果已经设置了一个公式来执行VLOOKUP，是否需要从C列复制值？嗨，Tom，我可以使用MATCH获得超链接功能的唯一方法是使用以下命令：
=HYPERLINK（#“&CELL（“address”），INDEX（Sheet2！B2:B9，MATCH（B6，Sheet2！B2:B9,0）），Sheet2！$A2）=HYPERLINK（#“&CELL（“address”），INDEX（Sheet2！B2:B9，MATCH（B6，Sheet2！B2:B9,0）），Sheet2！$A2）