Kopyala yapıştır işleminden sonra çalışacak kod hk

[ersoyalan]

Arkadaşlar merhaba,

Export ettiğimiz bir raporu başka bir rapor sayfasına kopyala yapıştır yapıyoruz. Yapıştır işlemini yaptığımız anda devreye girecek ve aşağıda belirtmiş olduğum işlemi yapacak koda ihtiyacım var.

AD2 hücresinde (Donanım Diğer - Yedek Parça Kaynaklı Kesinti) yazıyor ise Z2 hücresinde bulunan değerin silinip yerine Donanım Diğer olarak değişmesi gerekiyor.

AD10 Hücresinde (Operasyon Diğer - Tarif Edilemeyen Durum) yazıyor ise Z10 hücresinde bulunan değerin silinip yerine Operasyon Diğer olarak değişmesi gerekiyor.

Bu işlemi formül kullanarak yapabiliyorum. Fakat bana makro ile bu işi yapabileceğim kod gerekiyor. Bir çok çalışmaya baktım istediğim gibi olanına denk gelemedim.

Ben sadece 2 örnek belirttim aslında koşul yaklaşık 10 adet kadar. AD ve Z stunlarında 10000 adede kadar veri olabiliyor.

Konu hakkında yardımcı olabilir misiniz?


Teşekkür eder iyi çalışmalar dilerim.
Syg,

E.ALAN

 

[Korhan Ayhan]

Merhaba,

Yapıştırma işlemi yapacağınız sayfanızın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("AD2") = "Donanım Diğer - Yedek Parça Kaynaklı Kesinti" Then Range("Z2") = "Donanım Diğer"
    If Range("AD10") = "Operasyon Diğer - Tarif Edilemeyen Durum" Then Range("Z10") = "Operasyon Diğer"
End Sub

 

[ersoyalan]

Korhan Hocam merhaba,

Kod gayet güzel çalışıyor fakat sabit hücrelerde işimi görüyor.

Şöyle olması gerekiyor. Z stununu ve AD stununu genel kapsayan kod olmalı. AD2 yerine AD50 -AD100 - AD 455 - AD 1000 de olabilir. Aslında iki stun karşılaştırılacak ve ilk mesajımda bahsettiğim işlem olacak. Umarım şimdi anlatabilmişimdir.

 

[Korhan Ayhan]

Merhaba,

Bu durumda döngü ile işlem yapmak daha uygun olur.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Hücre As Range
    
    On Error GoTo Son
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    For Each Hücre In Selection
        Select Case Hücre.Value
            Case "Donanım Diğer - Yedek Parça Kaynaklı Kesinti"
                Cells(Hücre.Row, "Z") = "Donanım Diğer"
            Case "Operasyon Diğer - Tarif Edilemeyen Durum"
                Cells(Hücre.Row, "Z") = "Operasyon Diğer"
        End Select
    Next
 
Son:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[ersoyalan]

Korhan Hocam,

Ekli dosya ekliyorum. Daha açıklayacı olması için Flitre ile süzdüm. Z stununda olması gereken kısımları AA stununda belirttim.

İnceliyebilirmisiniz.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Hücre As Range, İlk As Long, Son As Long
    
    If Intersect(Target, Range("AD:AD")) Is Nothing Then Exit Sub
    
    On Error GoTo Son
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    İlk = Split(Split(Selection.Address, ":")(0), "$")(2)
    Son = Split(Split(Selection.Address, ":")(1), "$")(2)
    Range("Z" & İlk & ":Z" & Son).ClearContents
    
    For Each Hücre In Selection
        If InStr(1, Hücre.Value, "-") > 0 Then
            Cells(Hücre.Row, "Z") = Replace(Split(Hücre.Value, " - ")(0), " (", "")
        End If
    Next
 
Son:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[ersoyalan]

Korhan Hocam,

Kodları eklediğim dosya üzerinde deniyorum değişiklik olmuyor. Hatamı yapıyorum acaba.

 

[Korhan Ayhan]

Merhaba,

Siz kodun "yapıştır" yaptıktan sonra çalışmasını istemişsiniz. Yapıştırma işlemi yaptığınızda hücreler değişir. Bu sebeple "Change" olayı devreye girer.

Kodun çalışması için AD sütununa veri yapıştırın ve deneyin.

 

[ersoyalan]

Korhan Hocam,

Daha sonra tekrar denedim oldu. Fırsat bulamamıştım yazmaya.

Çok teşekkür ederim yardımlarınız için.