Üst satırdan Otomatik formül Kopyalama ve Kısıtlama

[ravensqu]

Merhaba Arkadaşlar,

Excel bilgim şu aşamada çok iyi olmadığı için ve de acil bir çalışmaya ihtyiacım olduğu için konuyu buraya yazıyorum. Yol gösterebilecek, yardımcı olabilecek olan varsa sevinirim.

1. konu

Dosyada bir veri alınan bir de işlem yapılan iki sayfa bulunmakta.

İlgili kişi Ekteki dosyada Ürün kodu(A Sütunu) ve Ürün adedi(B Sütunu) kısmını el ile doldurduğunda C,D,E ve F Sütunlarındaki formüllerin aşağı otomatik kopyalanması gerekiyor. Her yeni sütun eklendiğinde bu işlem devam edebilir olmalı.

2. Konu ise,

E sütunu tam sayı olmalı eğer değil ise uyarı vermeli.


Konu hakkında yardımcı olabilecek arkadaşlarıma şimdiden teşekkür ediyorum.

 

[Emir Hüseyin Çoban]

. . .

2.Kısım için formül
=EĞER(MOD(B2/D2;1)=0;B2/D2;"Kalanlı")

. . .

 

[Murat OSMA]

1- Formüllerinizin başına bu kısmı ekleyin; =EĞER(A2="";"";mevcut formülünüz) ve aşağıya doğru çekin.

2- Koşullu Biçimlendirmede formül kısmına; =MOD(B2/D2;1)<>0 formülünü girin ve rengini belirleyin.

 

[ravensqu]

Öncelikle ilginiz için teşekkür ederim.

Konudaki 2. maddeyi sayenizde çözmüş oldum. Ancak 1. madde için şu kısıtı eklemem gerekli sanırım:

Formüllerin kopyalanacağı hücrelerde herhangi bir öncül formül olmayacak. Yani hücreler tamamiyle boşken A ve B sütununa veri girildiği taktirde diğer sütunlara formül bir üstteki satırdan kopyalanacak.

Murat OSMA Bey'in belirttiği şekilde 1- Formüllerinizin başına bu kısmı ekleyin; =EĞER(A2="";"";mevcut formülünüz) ve aşağıya doğru çekin. şeklinde yapınca içeriğinde zaten bir formül oluyor.

Belki bir Makro ile gidilebilir ancak o makroyu yazacak bilgi bende yok

Tekrar teşekkürler.

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın (F-C) kod bölümüne yapıştırıp dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:b200")) Is Nothing Then Exit Sub
Cells(Target.Row, 3).FormulaR1C1 = "=VLOOKUP(RC[-2],HacimDetay!C[-2]:C[23],3,0)"
Cells(Target.Row, 4).FormulaR1C1 = "=VLOOKUP(RC[-3],HacimDetay!C[-3]:C[11],6,0)"
Cells(Target.Row, 5).FormulaR1C1 = "=RC[-3]/RC[-1]"
Cells(Target.Row, 6).FormulaR1C1 = "=RC[-3]*RC[-1]"
If Int(Cells(Target.Row, "e")) <> Cells(Target.Row, "e") Then
uyarı = MsgBox("Kutu adedi tamsayı çıkmıyor, lütfen sipariş miktarını düzeltiniz!", vbCritical)
Cells(Target.Row, "b").Select
End If
End Sub

 

[ravensqu]

Aşağıdaki kodları ilgili sayfanın (F-C) kod bölümüne yapıştırıp dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:b200")) Is Nothing Then Exit Sub
Cells(Target.Row, 3).FormulaR1C1 = "=VLOOKUP(RC[-2],HacimDetay!C[-2]:C[23],3,0)"
Cells(Target.Row, 4).FormulaR1C1 = "=VLOOKUP(RC[-3],HacimDetay!C[-3]:C[11],6,0)"
Cells(Target.Row, 5).FormulaR1C1 = "=RC[-3]/RC[-1]"
Cells(Target.Row, 6).FormulaR1C1 = "=RC[-3]*RC[-1]"
If Int(Cells(Target.Row, "e")) <> Cells(Target.Row, "e") Then
uyarı = MsgBox("Kutu adedi tamsayı çıkmıyor, lütfen sipariş miktarını düzeltiniz!", vbCritical)
Cells(Target.Row, "b").Select
End If
End Sub

Yusuf Bey, Öncelikle çok teşekkürler. Verdiğiniz kodu denedim. oldukça yol kat etmiş olduk

Şu konularda yardımcı olabilir misiniz?

1- Kutu adedi konusunda uyarıyı veriyor. Ancak buna rağmen rakamı işliyor. Yani kutudaki adedi 2 olan bir ürün için 3 adet sipariş girildiği anda uyarıyı veriyor. Ancak 1,5 olarak Kutu adedi sütununa sonuç getiriyor. Bu koşulda, sonuç yerine kutu adedi sütununa HATA! gibi bir şey yazdırmak mümkün müdür?

2- A Sütunundaki değeri sildiği anda Bug(Type Mismatch) veriyor. Acaba A sütunu silindiği anda yanındaki tüm satırları da silecek bir kod eklenebilir mi?

Tekrar çok sağolun.

 

[YUSUF44]

Kodu aşağıdaki gibi değiştirirseniz sipariş adedini düzgün girinceye kadar uyarı verir:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a2:b200")) Is Nothing Then Exit Sub
Cells(Target.Row, 3).FormulaR1C1 = "=VLOOKUP(RC[-2],HacimDetay!C[-2]:C[23],3,0)"
Cells(Target.Row, 4).FormulaR1C1 = "=VLOOKUP(RC[-3],HacimDetay!C[-3]:C[11],6,0)"
Cells(Target.Row, 5).FormulaR1C1 = "=RC[-3]/RC[-1]"
Cells(Target.Row, 6).FormulaR1C1 = "=RC[-3]*RC[-1]"
If Int(Cells(Target.Row, "e")) <> Cells(Target.Row, "e") Then
uyarı = MsgBox("Kutu adedi tamsayı çıkmıyor, lütfen sipariş miktarını koli içi adedin (" & Cells(Target.Row, 4) & ") katları olarak düzeltiniz!", vbCritical)
Cells(Target.Row, "b").Select
Selection.ClearContents
End If
End Sub

Silerken type mismatch hatası vermesi konusunda maalesef ne yapılacağını bilmiyorum. Araştırdım ama bulamadım.

 

[Murat OSMA]

Yusuf Bey'in müsadesiyle...

Bu kodları önerebilirim;

[FONT="Trebuchet MS"]Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A2:B200")) Is Nothing Then Exit Sub
    Range("C" & Target.Row - 1 & ":F" & Target.Row - 1).[COLOR="Red"]AutoFill [/COLOR]_
    Destination:=Range("C" & Target.Row - 1 & ":F" & Target.Row), Type:=[COLOR="red"]xlFillDefault[/COLOR]
    On Error Resume Next
   [COLOR="red"] If Target.Value = "" Then Cells(Target.Row, 3).Resize(, 4).ClearContents[/COLOR]
    If Int(Cells(Target.Row, "E")) <> Cells(Target.Row, "E") Then
        uyarı = MsgBox("Kutu adedi tamsayı çıkmıyor, lütfen sipariş miktarını düzeltiniz!", vbCritical)
        Cells(Target.Row, "B").Select
    End If
End Sub[/FONT]

 

[YUSUF44]

Teşekkürler sayın Murat OSMA.

 

[Murat OSMA]

Rica ederim Yusuf Bey, umarım Sn. ravensqu'nun da işine yaramıştır.

 

[ravensqu]

Öncelikle hepinize ayrı ayrı teşekkür ederim. Dosya sayenizde kullanılabilir oldu

Saygılar.

 

[Murat OSMA]

Kodlar Yusuf Bey'in, ben sadece ufak bir ilave yaptım.

Hoşça kalın...