6000mm göre düzenleme

[k0081]

Merhaba arkadaşlar;

örnek tabloda ki verileri 6000mm yi baz alarak düzenleyebilirmiyiz? ekteki dosyada detay verdim. istenen tablonun bir örneğini aynı sayfaya kopyaladım.. bilgi açısından.. burdaki bilgiler yine B19 dan başlayan tabloda güncellenecektir..


yardımcı arkadaşa şimdiden teşekkürler.

 

[cenk e.]

Merhaba, doğru mu anladım hiç emin değilim ama eğer istediğiniz 6000'den fazla olan kısımların 6000 ile değiştirilmesi ise şu kodu butona atayabilirsiniz.

Private Sub CommandButton1_Click()  
For i = 19 To [d65536].End(xlUp).Row  
If Cells(i, "D") > 6000 Then  
Cells(i, "D").Value = 6000  
End If  
Next  
End Sub

 

[k0081]

evet hocam bi kısmı öyle. ama 6000 den fazlası olan kısımlarda lazım.. örnek tabloda belirtmiş olduğum alt kısımdaki mavi değerler 6000 den çıkarılmış kalan değerlerdir.. bunlarda gerekli bana hocam.

 

[cenk e.]

Merhaba,

Private Sub CommandButton1_Click()

sds = Sheets("KOLON").Range("d65536").End(xlUp).Row
bs = sds + 1
For i = 19 To [d65536].End(xlUp).Row
If Cells(i, "D") > 6000 Then
Cells(bs, "B") = Cells(i, "B").Value
Cells(bs, "D") = Cells(i, "D").Value - 6000
Cells(bs, "E") = Cells(i, "E").Value
bs = bs + 1
Cells(i, "D") = 6000
End If
Next
End Sub

Kodları şu şekilde düzenledim, bu haliyle dener misiniz?

 

[k0081]

cenk e.;

Hocam çok Teşekkürler, Tamamdır.. tam istediğim gibi olmuş.. saygılar..