VBA 不相邻列的条件复制代码

Question

项目主管

在使用 VBA 的 MS Excel 中，我需要一些有关同一工作簿内工作表之间条件复制的帮助。根据所附图片，我在工作表 "Master" 上有一个项目主列表。对于 I 列（缺陷）中具有 "yes" 的所有项目，我想复制 A 列（工程包发布日期）、B（项目编号）、E（城市）和 H（ Contract Value) 到同一工作簿中的另一个工作表 "Defects"。您能否提供一个编码，该编码可以： a) 折叠所有行，使 "Defects" 工作表中没有空白行；和 b) 保留所有行，因此如果 "Defect" 列有一个 "No"，"Master" 工作表中的相关行将被复制为 "Defect" 工作表中的空白行，如果可能的话。请帮助我进行编码 - 我对宏有非常基本的了解，并且正在学习如何编码。谢谢和问候，CK

Answer 1

试试这个让你入门。另外，以后请 post 你有什么代码，你得到什么错误，或者你有一个特定的问题，而不是要求代码来解决问题。这里有许多其他 post 用户，如果您没有表现出您已付出一些努力自行提出解决方案，他们只会对您投反对票或删除您的 post。

Sub CopyValues()

'Declare variables
'Declare sheet variables
Dim Masterws as Worksheet
Dim Defectws as worksheet

'Declare counter variables
Dim I as Integer
Dim n as Integer

'Set value of sheet variables
Set Masterws=ThisWorkbook.Sheets("Master")
Set Defectws=ThisWorkbook.Sheets("Defects")

'Set value of counter to track first available row on Defects sheet
n=1

'Start a For loop to check each row on Master sheet, starting with row 2
For I = 2 to WorksheetFunction.CountA(Masterws.Columns.EntireColumn(1))

    'If the cells in row I, column I have a value of, "Yes," then execute some code. If not, continue on.
    If Cells(I, "I").value= "Yes" Then

        'Set the value of cells in row n of the Defects sheet to the corresponding values of row I in the Master sheet. If n is replaced with I, then the value of cells in row I on Defects will be set to the values of Row I on Master, leaving blank rows where no, "Yes," was found because no copying took place.
        Defectws.Cells(n,"A").Value=Masterws.cells(I,"A")
        Defectws.Cells(n,"B").Value=Masterws.cells(I,"B")
        Defectws.Cells(n,"C").Value=Masterws.cells(I,"E")
        Defectws.Cells(n,"D").Value=Masterws.cells(I,"H")

        'Add 1 to the n counter. The next time a row is found in the Master sheet with, "Yes," it will be written to the next available row down on the Defects sheet.
        n=n+1

    End If

'End of the For loop. Move on to the next row on Master sheet
Next

End Sub

Answer 2

@asp8811 感谢您提供代码，效果很好。抱歉，我没有早点放我已经拥有的东西——我是 Stack Overflow 的新手，也是编码的新手——以后总是从我的代码开始。以下是我到目前为止的内容 - 结合您的代码和我之前问过的另一个问题的答案。您的代码运行良好，让我能够选择我选择的列，这与我下面的代码不同 - 它打印 A 和 H 之间的所有列。我的挑战是我想保留这些行（作为空白行）如果有缺陷列中的 "No" - 这是我在下面的内容，但我也想只报告那些不相邻的列，并且能够像你一样 select 列。

Sub CopyValues()

Dim Masterws As Worksheet
Dim Defectws As Worksheet
Dim I As Integer
Dim n As Integer

Set Masterws = ThisWorkbook.Sheets("Master")
Set Defectws = ThisWorkbook.Sheets("Defects")

n = 1

For I = 2 To WorksheetFunction.CountA(Masterws.Columns.EntireColumn(1))

    If (Masterws.Range("J" & I) = "Yes") Then
    Masterws.Range("A" & I & ":H" & I).Copy Destination:=Worksheets("Defects").Range("A" & I)

   n = n + 1
   End If

Next
End Sub

VBA 不相邻列的条件复制代码

VBA Code for Conditional Copying of Columns Not Adjacent to each other

excel

conditional

vba