Aynı formülü gerçekleştiren bir döngüye ihtiyacınız var ama aşağıdaki sütun için

Question

göründüğü gibi, bir sonraki değere her gittiğimde tekrarlamak istiyorum ... Bunu yapmak için daha kolay bir yol var mı?

Döngü işlevini denedim, ancak bunu nasıl çalıştıracağımı bilmiyorum, böylece aynı satır için her defasında bir sonraki sütuna geçecek.

Sub rebuild() 
If D28 > 2600000 Then 
Range("E$110:I$120").Select 
Selection.Copy 

Range("E18:Il28").Select 
ActiveSheet.Paste 
End If 

If E28 > 2600000 Then 
Range("E$110:I$120").Select 
Selection.Copy 

Range("F18:Jl28").Select 
ActiveSheet.Paste 

End If 

If F28 > 2600000 Then 
Range("E$110:I$120").Select 
Selection.Copy 

Range("G18:Kl28").Select 
ActiveSheet.Paste 

End If 


If G28 > 2600000 Then 
Range("E$110:I$120").Select 
Selection.Copy 

Range("H18:Ll28").Select 
ActiveSheet.Paste 

End If 


End sub 

Answer 1

bir çözüm bir dizi halinde değişkenleri koymak ve sonra basit for döngü yapmak olabilir.

Dim MyArray(4, 2) as Variant 
MyArray(0,0) = D28 
MyArray(0,1) = Range("E18:Il28") 
MyArray(1,0) = E28 
MyArray(1,1) = Range("F18:Jl28") 
MyArray(2,0) = F28 
MyArray(2,1) = Range("G18:Kl28") 
MyArray(3,0) = G28 
MyArray(3,1) = Range("H18:Ll28") 

For i = LBound(MyArray) to UBound(MyArray) 
    If MyArray(i,0) > 2600000 then 
     Range("E$110:I$120").Copy 
     MyArray(i,1).Paste 
    End If 
Next 

Answer 2

Bu gerçekten çok basit. Kodu açıkladım. Ayrıca kopyalamak/yapıştırmak için bir aralık seçmeniz gerekmez. Ben D28` `değeri ("D28") Hücreler` olduğunu varsayarak değilim THIS

Sub rebuild() 
    With Sheet1 '~~> Change this to the relevant sheet 
     For i = 4 To 6 '<~~ Col 4 (D) to Col 6 (F) 
      If .Cells(28, i).Value > 2600000 Then 
       '~~> Increment the range wgere you want to paste 
       .Range("E$110:I$120").Copy .Range(.Cells(18, i + 1), .Cells(128, i + 5)) 
      End If 
     Next i 
    End With 
End Sub