change olayında farklı iki makroyu nasıl çalıştırabilirim

ismailozkan4224 · 9 Kasım 2018

aşağıdaki makro ayrı ayrı çalışmaktadır. ancak ikisini birlikte kullanmak istemekteyim. uyarlanabilir mi?

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo son
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
Cells(Target.Row, "A:A") = Format(Now(), "yyyy-MM-dd hh:mm:ss")
son:
Call SATIR_RENKLENDIR17

On Error GoTo son
If Intersect(Target, [C:J]) Is Nothing Then Exit Sub
Call SATIR_RENKLENDIR17

End Sub

hamitcan · 9 Kasım 2018

Kodu bu şekilde deneyin.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [B:b]) Is Nothing Then
        MsgBox "evet"
    ElseIf Not Intersect(Target, [c:j]) Is Nothing Then
        MsgBox "evet"
    End If
End Sub

ismailozkan4224 · 12 Kasım 2018

teşekkür ederim hamitcan bey. işlem tamam.

ismailozkan4224 · 13 Kasım 2018

hamitcan bey aşağıdaki kodlar ayrı ayrı iken çalışıyor. ancak ikisini bir birbirine ilave ettiğimde hata veriyor. yukarıdaki örneğinize göre uyarladım ama olmadı.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, [N4]) Is Nothing Then

Cells(4, 1) = Format(Now(), "MM-DD-YYYY hh:mm:ss")

Call satirekle
Call bicimkopyala
Cells(5, 1) = Cells(4, 1)
Cells(5, 2) = Cells(4, 2)
Cells(5, 3) = Cells(4, 3)
Cells(5, 4) = Cells(4, 4)
Cells(5, 5) = Cells(4, 5)
Cells(5, 6) = Cells(4, 6)
Cells(5, 7) = Cells(4, 7)
Cells(5, 8) = Cells(4, 8)
Cells(5, 9) = Cells(4, 9)
Cells(5, 10) = Cells(4, 10)
Cells(5, 11) = Cells(4, 11)
Cells(5, 12) = Cells(4, 12)
Cells(5, 13) = Cells(4, 13)
Cells(5, 14) = Cells(4, 14)
Call SATIR_RENKLENDIR
Call bicimlendir
son:

If Not Intersect(Target, [E5:N5000]) Is Nothing Then
Call SATIR_RENKLENDIR1

End If
End Sub

ismailozkan4224 · 13 Kasım 2018

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B:b]) Is Nothing Then
1.kod
ElseIf Not Intersect(Target, [c:j]) Is Nothing Then
2. kod
End If
End Sub

yazdım ama 2. kodda end ıf hatası veriyor

ismailozkan4224 · 13 Kasım 2018

bu kodda da hata veriyor.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [N4]) Is Nothing Then Exit Sub
Cells(4, 1) = Format(Now(), "MM-DD-YYYY hh:mm:ss")

Call satirekle
Call bicimkopyala
Cells(5, 1) = Cells(4, 1)
Cells(5, 2) = Cells(4, 2)
Cells(5, 3) = Cells(4, 3)
Cells(5, 4) = Cells(4, 4)
Cells(5, 5) = Cells(4, 5)
Cells(5, 6) = Cells(4, 6)
Cells(5, 7) = Cells(4, 7)
Cells(5, 8) = Cells(4, 8)
Cells(5, 9) = Cells(4, 9)
Cells(5, 10) = Cells(4, 10)
Cells(5, 11) = Cells(4, 11)
Cells(5, 12) = Cells(4, 12)
Cells(5, 13) = Cells(4, 13)
Cells(5, 14) = Cells(4, 14)
Call SATIR_RENKLENDIR
Call bicimlendir

Cells(4, 1) = ""
Cells(4, 2) = ""
Cells(4, 3) = ""
Cells(4, 4) = ""
Cells(4, 5) = ""
Cells(4, 6) = ""
Cells(4, 7) = ""
Cells(4, 8) = ""
Cells(4, 9) = ""
Cells(4, 10) = ""
Cells(4, 11) = ""
Cells(4, 12) = ""
Cells(4, 13) = ""
'Cells(4, 14) = ""
son:
ElseIf Intersect(Target, [E5:N5000]) Is Nothing Then
Call SATIR_RENKLENDIR1
End If

End Sub

Ömer BARAN · 13 Kasım 2018

Merhaba.

İsterseniz bir de aşağıdaki gibi bir kod yapısını deneyin.
Kod'daki If ve Elseif satırlarında, Then ibaresinden önce And Target<>"" veya And Target.Row<100 gibi gibi ilave koşullar da ekleyebilirsiniz.

Yine sonuç alamazsanız; sorunuzu, gerçek belgenizin, özel bilgi içermeyen kopyası şeklinde hazırlayacağınız örnek belge üzerinden ve
belge içerisine her bir seçenek için yapılacak işlemleri belirten kısa/net açıklamalar ekleyerek sorunuz.
ALTIN ÜYELİK olduğuna göre, örnek belge ekleme sorunu da yok.

Rich (BB code):

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column = 2 Then
        MsgBox "B sütunundaki hücreye bağlı işlemler yapılacak"
        Exit Sub
    ElseIf Target.Column > 2 And Target.Column < 11 Then
        MsgBox "C:J sütunlarındaki hücrelere bağlı işlemler yapılacak"
        Exit Sub
    ElseIf Target.Address(0, 0) = "N4" Then
        MsgBox "N4 hücresine bağlı işlemler yapılacak"
        Exit Sub
    End If

End Sub

hamitcan · 13 Kasım 2018

Bence yazdığınız kodlarda birbiri ile çakışan durumlar olabilir. Kod satırlarını tek tek ekleyip kodun çalışmasını izleyin.

ismailozkan4224 · 13 Kasım 2018

elseıf kodunda hata veriyor. else whithout if hatası. kodu aşağıdaki gibi düzenledim. ama malesef. dosya için özür dilerim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [N4]) Is Nothing Then Exit Sub
Cells(4, 1) = Format(Now(), "MM-DD-YYYY hh:mm:ss")
Call satirekle
Call bicimkopyala
Cells(5, 1) = Cells(4, 1)
Cells(5, 2) = Cells(4, 2)
Cells(5, 3) = Cells(4, 3)
Cells(5, 4) = Cells(4, 4)
Cells(5, 5) = Cells(4, 5)
Cells(5, 6) = Cells(4, 6)
Cells(5, 7) = Cells(4, 7)
Cells(5, 8) = Cells(4, 8)
Cells(5, 9) = Cells(4, 9)
Cells(5, 10) = Cells(4, 10)
Cells(5, 11) = Cells(4, 11)
Cells(5, 12) = Cells(4, 12)
Cells(5, 13) = Cells(4, 13)
Cells(5, 14) = Cells(4, 14)
Call SATIR_RENKLENDIR
Call bicimlendir
Cells(4, 1) = ""
Cells(4, 2) = ""
Cells(4, 3) = ""
Cells(4, 4) = ""
Cells(4, 5) = ""
Cells(4, 6) = ""
Cells(4, 7) = ""
Cells(4, 8) = ""
Cells(4, 9) = ""
Cells(4, 10) = ""
Cells(4, 11) = ""
Cells(4, 12) = ""
Cells(4, 13) = ""
'Cells(4, 14) = ""
son:
ElseIf Target.Column > 5 And Target.Column < 14 Then
Call SATIR_RENKLENDIR1
Exit Sub
End If

End Sub

Ömer BARAN · 14 Kasım 2018

Tekrar merhaba.

Kullandığınız kodlarla ne yapmaya çalıştığınızı pek anlamadım ama;
mevcut Worksheet_Change kod blokunu tamamen silip yerine aşağıdaki kısaltılmış kod blokunu kullanabilirsiniz.

Rich (BB code):

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 5 And Target.Column < 14 Then
        Call SATIR_RENKLENDIR1
        Exit Sub
    ElseIf Target.Address(0, 0) = "N4" Then
        Cells(4, 1) = Format(Now(), "MM-DD-YYYY hh:mm:ss")
        Call satirekle
        Call bicimkopyala
            For sut = 1 To 14
                Cells(5, sut) = Cells(4, sut)
            Next
        Call SATIR_RENKLENDIR
        Call bicimlendir
            Range("A4:M4").ClearContents
            Exit Sub
    End If
End Sub

ismailozkan4224 · 14 Kasım 2018

hamit bey dosya ekte. yapmaya çalıştığım ise
1- 4 satırda bilgi girişi yapıp N4 hücresinde enter dendiğinde ilgili satırın altına bir satır ekleyecek , o satıra girilen bilgileri eklenen satıra aktaracak, (mavi satırı) ilk bilgi girilen satırı boşaltacak.
2- E5:M5000 arasındaki satırlara İMALATTA girildiğinde kırmızı, BİTTİ girildiğinde yeşil, diğer bilgilerde sarı, hücre boş ise renksiz olacak

Ömer BARAN · 14 Kasım 2018

Verdiğim iki cevap var.
Bu cevaplarımla ilgili olarak konu sahibinin olumlu/olumsuz herhangi bir geri bildirimi de olmadığına göre destek ihtiyacınız yok sanırım.

Ama yine de son bir cevap yazayım dedim.

İstediğiniz sonuca ulaşmak için modullerdeki kodlara (RENKLENDİR/EKLE/BİÇİMLENDİR gibi) ihtiyaç olmadığını düşünüyorum.
Mevcut .Worksheet_Change kod blokunu tamamen silip yerine aşağıdakini kullanarak istediğiniz (ve daha hızlı) sonuca ulaşabilir.

NOT: Biçimlendirme sırasında, daha yumuşak renkleri kullanırsanız sayfanız göze daha iyi görünebilir diye düşünüyorum.

Rich (BB code):

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column > 5 And Target.Column < 14 Then
        Target.Interior.Color = xlNone
        If Target <> "" Then Target.Interior.Color = vbYellow
        If Target = "İMALATTA" Then Target.Interior.Color = vbRed
        If Target = "BİTTİ" Then Target.Interior.Color = vbGreen
        Exit Sub
    ElseIf Target.Address(0, 0) = "N4" Then
        [A4] = Format(Now(), "YYYY-MM-DD hh:mm:ss")
        Rows("5:5").Insert Shift:=xlDown
        [A4:M4].Copy: [A5].PasteSpecial Paste:=xlPasteValues
        [N6].Copy: [N5].PasteSpecial Paste:=xlPasteFormats
        [A6:D6].Copy: [A5:D5].PasteSpecial Paste:=xlPasteFormats
        [N6].Copy: [N5].PasteSpecial Paste:=xlPasteFormats
            For sut = 5 To 13
                Cells(5, sut).Interior.Color = xlNone
                If Cells(5, sut) <> "" Then Cells(5, sut).Interior.Color = vbYellow
                If Cells(5, sut) = "İMALATTA" Then Cells(5, sut).Interior.Color = vbRed
                If Cells(5, sut) = "BİTTİ" Then Cells(5, sut).Interior.Color = vbGreen
            Next
        [A4:M4].ClearContents: Rows("5:5").AutoFit: [N4].Activate
        Exit Sub
    End If
End Sub

ismailozkan4224 · 16 Kasım 2018

teşekkürler ömer bey.işlem tamam

Ömer BARAN · 16 Kasım 2018

Kolay gelsin.

change olayında farklı iki makroyu nasıl çalıştırabilirim

ismailozkan4224

hamitcan

Uzman

ismailozkan4224

ismailozkan4224

ismailozkan4224

ismailozkan4224

Ömer BARAN

Uzman

hamitcan

Uzman

ismailozkan4224

Ekli dosyalar

Ömer BARAN

Uzman

ismailozkan4224

Ömer BARAN

Uzman

ismailozkan4224

Ömer BARAN

Uzman