2 Kod Nasıl Birleştirilir ?

[baydeniro]

Merhaba arkadaşlar. Sayın Cost Control ve Sayın Necdet Yesertener üstatların yardımı ile 2 tane harika kod üretildi. Bu kodları aynı sayfada uygulamak istediğimde ise başarılı olamadım. Acaba bu konuda yardımcı olabilir misiniz. Ekteki dosyada bulunan 2 adet kodu birleştirmek istiyorum.

1. Kod : J3 : J 39 arasında. İşlevi D kolonuna bir bilgi yazıldığında A, B ve C yi bir aşağıya kopyalamak, E kolonuna F sayfasında fiyat rakam getirmek.

2. Kod : J42 : J 46 arasındadır. İşlevi F kolonuna rakam girildiğinde E ile F yi çarpıp G kolununa sonucu yazmak.

 

[xxcell]

Kodu şu şekilde birleştirmelisiniz.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)


If Not Intersect(Target, [B2:B65000]) Is Nothing Then
For sira = 2 To [B65000].End(3).Row
Range("A" & sira) = sira - 1
Next
Else


    If Intersect(Target, [D2:D65536]) Is Nothing Then [COLOR="Red"]GoTo ikincikod:[/COLOR]    
    ' siz bu satiri ..... exit sub olarak yazdığınızdan  [d2:d65536] olmadigi 
    '  durumlarda olaydan çıkıyor. Bunu Goto ikincikod: yaparak yonlendirmeyi oraya
    ' yapmalısınız.
    
    If InStr(1, Target.Address, ":") <> 0 Then Exit Sub
    If Not IsEmpty(Target) Then
    Cells(Target.Row, 1) = Target.Row - 1
    Cells(Target.Row, 2) = IIf(Cells(Target.Row, 2) = "", Cells(Target.Row - 1, 2), Cells(Target.Row, 2))
    Cells(Target.Row, 3) = IIf(Cells(Target.Row, 3) = "", Cells(Target.Row - 1, 3), Cells(Target.Row, 3))
    Else
    Cells(Target.Row, 1) = ""
    Cells(Target.Row, 2) = ""
    Cells(Target.Row, 3) = ""
    End If


Application.ScreenUpdating = False
On Error Resume Next
If Intersect(Target, Range("D2:d1000")) Is Nothing Then Exit Sub
sons = Sheets("F").Cells(65536, 1).End(xlUp).Row
aranan = Target.Value & Target.Offset(0, -1)
'Sheets("F").Select
For i = 1 To sons
bul = Sheets("F").Cells(i, 2) & Sheets("F").Cells(i, 3)
If bul = aranan Then

adres = Sheets("F").Cells(i, 2).Row
Target.Offset(0, 1) = Sheets("F").Cells(adres, 4)
End If
Next

End If

[COLOR="red"]Exit Sub[/COLOR]
' ikincikod: kısmına gelmeden once exit sub ilave etmelisiniz

[COLOR="red"]ikincikod:[/COLOR]

' ikinci kodu buraya ilave etmelisiniz.

If Intersect(Target, [F:F]) Is Nothing Then Exit Sub
Target.Offset(0, 1) = Target * Target.Offset(0, -1)
Target.Offset(0, 2).Select


End Sub

 

[baydeniro]

Teşekkürler

Sayın xxcell çok çok teşekkürler. İnanın çok makbule geçti. Ayrıca bir konuda size danışabilir miyim : Makroda bir hücreye giriş yapıp enter'a basınca 2 sağa gitmesi nasıl sağlanabilir. Bununla ilgili olarak şu kod doğru mudur ?

Target.Offset(0, 2).Select

 

[xxcell]

şu kod doğru mudur ?
Target.Offset(0, 2).Select

Doğrudur..........

 

[baydeniro]

xxcell çok teşekkürler.