Question

要根据其内容复制行范围，并根据列中的标志值将其粘贴到下面的行中。例如。

在范围B1：G1，iF B1 = TEST中，下一步移动，直到该行值不等于TEST。例如，假设B1，C1和D1等于TEST，并且从E1开始不等于TEST（简而言之，我们需要首先检查第B1:G1行中的TEST值，然后从该地址开始复制，但从下一行直到结尾），然后复制E2:G2（而不是E1：G1，因为这是条件行），然后在下面的行中粘贴E3:G10。

在粘贴E3:G10时，它需要检查A3中的值：A中的最后一行，让A3 = X然后将以上逻辑粘贴到E3:G3，然后粘贴A4 = Y然后跳过，接下来是A5 = X，然后将以上逻辑粘贴到E5:G5.....and so on。

简而言之，我们需要首先确定范围B1:G1中的第一个<> TEST成员，并从该列但从该行的下方复制范围，并粘贴在所有下面的行中，并根据A列中的标志位略过一些。 >

下面的代码可以正常工作，但是它清除了我们不需要的跳过行的内容。新代码应可使A3到A列的最后一行。

Sub CopyOnCondition1()    
     Dim sh1 As Worksheet, c As Range    
     Set sh1 = Worksheets("SheetNameHere") 'change the sheetname

     For Each cel In sh1.Range("I11:T11")    
        If Not cel.Value = "TEST" Then    
            sh1.Range(Cells(12, cel.Column), Cells(12, 20)).Copy
            sh1.Range(Cells(13, cel.Column), Cells(24, 20)).PasteSpecial xlPasteFormulas    
        End If    
     Next

     For Each cel In sh1.Range("H13:H24")    
        If cel.Value = "Y" Then sh1.Range("I" & cel.Row & ":T" & cel.Row).ClearContents    
     Next        
End Sub

Answer 1

尝试：

Sub CopyOnCondition1()
     Dim sh1 As Worksheet, c As Range
     Set sh1 = Worksheets("SheetNameHere") 'change the sheetname
     Dim cl As Range
     Dim cel As Range

     For Each cel In sh1.Range("I11:T11")
        If Not cel.Value = "TEST" Then

            sh1.Range(Cells(12, cel.Column), Cells(12, 20)).Copy
            For Each cl In sh1.Range(Cells(13, cel.Column), Cells(24, cel.Column))
                  If Not sh1.Cells(cl.row, 8).Value = "Y" Then cl.PasteSpecial xlPasteFormulas
            Next
            Exit For
        End If

     Next

End Sub

根据同一行的内容动态复制行范围

1 个答案: