İki kodun birlikte çalışmasını sağlamak

[wnkist]

İyi Günlerr;

Bu iki kodunda aynı sayyada çalışmasını istiyorum. Nasıl yapabileceğim hakkında yardım ederseniz sevinirim.

Teşekkürler

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rky As Range
    If Target.Column <> 1 Then Exit Sub
    Set Rky = Sayfa1.Columns(1).Find(Target.Value, , , 1)
    If Not Rky Is Nothing Then
        Sayfa1.Cells(Rky.Row, "B").Resize(, 4).Copy
        Cells(Target.Row, "B").PasteSpecial xlPasteValues
        Sayfa1.Cells(Rky.Row, "H").Resize(, 2).Copy
        Cells(Target.Row, "F").PasteSpecial xlPasteValues
        Sayfa1.Cells(Rky.Row, "F").Copy
        Cells(Target.Row, "H").PasteSpecial xlPasteValues
        Sayfa1.Cells(Rky.Row, "K").Copy
        Cells(Target.Row, "I").PasteSpecial xlPasteValues
    End If
    Application.CutCopyMode = False
    Set Rky = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [F:F]) Is Nothing Then Exit Sub

If Trim(Target.Value) = "PROJE" Then
    Renk = 38
    
ElseIf Trim(Target.Value) = "ÜRETİM" Then
    Renk = 16
    
ElseIf Trim(Target.Value) = "İMALAT" Then
    Renk = 44
    
ElseIf Trim(Target.Value) = "MONTAJ" Then
    Renk = 41
    
ElseIf Trim(Target.Value) = "OTOMASYON" Then
    Renk = 46
    
ElseIf Trim(Target.Value) = "HAZIR" Then
    Renk = 47
    
ElseIf Trim(Target.Value) = "İPTAL" Then
    Renk = 33
    
ElseIf Trim(Target.Value) = "SEVK" Then
    Renk = 43
    
ElseIf Trim(Target.Value) = "PLANLAMA" Then
    Renk = 40
    
End If

Range("A" & Target.Row & ":K" & Target.Row).Interior.ColorIndex = Renk

End Sub

 

[mancubus]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rky As Range
    
    Select Case Target.Column
        Case 1
            Set Rky = Sayfa1.Columns(1).Find(Target.value, , , 1)
            If Not Rky Is Nothing Then
                Cells(Target.Row, "B").Resize(, 4) = Sayfa1.Cells(Rky.Row, "B").Resize(, 4)
                Cells(Target.Row, "F").Resize(, 2) = Sayfa1.Cells(Rky.Row, "H").Resize(, 2)
                Cells(Target.Row, "H") = Sayfa1.Cells(Rky.Row, "F")
                Cells(Target.Row, "I") = Sayfa1.Cells(Rky.Row, "K")
            End If
        Case 6
            If Trim(Target.value) = "PROJE" Then Renk = 38
            If Trim(Target.value) = "ÜRETİM" Then Renk = 16
            If Trim(Target.value) = "İMALAT" Then Renk = 44
            If Trim(Target.value) = "MONTAJ" Then Renk = 41
            If Trim(Target.value) = "OTOMASYON" Then Renk = 46
            If Trim(Target.value) = "HAZIR" Then Renk = 47
            If Trim(Target.value) = "İPTAL" Then Renk = 33
            If Trim(Target.value) = "SEVK" Then Renk = 43
            If Trim(Target.value) = "PLANLAMA" Then Renk = 40
            Range("A" & Target.Row & ":K" & Target.Row).Interior.ColorIndex = Renk
        Case Else
    End Select
End Sub

 

[mancubus]

hatta şöyle daha kısa da olabilir..

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rky As Range, Dept, Renk
    
    Dept = Array("PROJE", "ÜRETİM", "İMALAT", "MONTAJ", "OTOMASYON", "HAZIR", "İPTAL", "SEVK", "PLANLAMA")
    Renk = Array(38, 16, 44, 41, 46, 47, 33, 43, 40)
    
    Select Case Target.Column
        Case 1
            Set Rky = Sayfa1.Columns(1).Find(Target.value, , , 1)
            If Not Rky Is Nothing Then
                Cells(Target.Row, "B").Resize(, 4) = Sayfa1.Cells(Rky.Row, "B").Resize(, 4)
                Cells(Target.Row, "F").Resize(, 2) = Sayfa1.Cells(Rky.Row, "H").Resize(, 2)
                Cells(Target.Row, "H") = Sayfa1.Cells(Rky.Row, "F")
                Cells(Target.Row, "I") = Sayfa1.Cells(Rky.Row, "K")
            End If
        Case 6
            Range("A" & Target.Row & ":K" & Target.Row).Interior.ColorIndex = _
                Renk(Application.Match(Target, Dept, 0) - 1)
        Case Else
    End Select
End Sub

 

[wnkist]

Merhaba;

İlgilendiğiniz için teşekkür ederim.

Vermiş olduğunuz kod çalışmıyor. İlk baştaki kod sayfa1 den arama yapıp sayfa2'deki ilgili hücrelere yapıştırıyordu. Bu işlemi yapmıyor ve "If Trim(Target.Value) = "PROJE" Then " hata veriyor.

 

[mancubus]

dosyanızı örnek veriler ile yüklerseniz bakayım.


bu arada 3 no.lu mesajda bir düzeltme yaptım.

dizi 0 tabanlı olduğu için index 0'dan başlıyor. match ise 1'den başlayarak bulduğu sıranın sayısını getirir.

bu anlamda eşleşmenin doğru olması açısından -1 ibaresini ekledim:
Renk(Application.Match(Target, Dept, 0) - 1)

 

[wnkist]

Örnek dosyayı ekledim.

Ben size ne yapmaya çalıştığımdan bahsedeyim.

Üretim iş programı sayfasına(üis) ilgli bilgileri dolduruyorum. Daha sonra 51.hafta kısmına sadece cihaz seri no'sunu(csn) girdiğimde, üis'dan csn'yı arayıp buluyor ve geri kalan kısımları otomatik olarak çekiyor.

ÜİS'da gerekli boya işlemleri çalışıyor. Anca aynı boyama işlemini 51.hafta sayfasında da yapmak istiyorum.

51.Hafta sayfasına yazdığım cihaz numarası ÜİS bulunamadıysa bir mesaj verebilir mi?

Bir ÜİS sağ tarafında malzeme takip bölümü bulunmakta buraya da durum hücresi eğerli formül neticesinde 1,2,3 gibi değerler alıyor. Bu değerleri aldığında Ürün,Depo,Durum hücrelerinin boyanmasını istiyorum. Benim bir makrom vardı ancak eğer formülüyle gelen değerleri otomatik olarak algılamıyor durum hücresine F2 enter yapmam gerekiyor. Bunu otomatik olarak nasıl doldurabiliriz.

İlgiliniz için teşekkür ederim...

 

[mancubus]

dosyayı göremiyorum. eklenmemiş galiba.

 

[wnkist]

Dosyayı eklemeyi unutmuşum. Şimdi ekledim.

 

[mancubus]

dosyadaki kodlar farklı ama zannedyorum her iki sayfada da işlem yapılacak...

siz 51. sayfanın change olyı için birleştirme istiyorsunuz.

ayrıca ÜRETİM İŞ PROGRAMI sayfasındaki kodlarda da tasarım hataları var. fırsatım olursa onlara da bakarım.

If Intersect(Target, [H4:R5000]) Is Nothing Then Exit Sub
dedikten sonra
If Target.Column = "8" ...
demeye gerek yok.

ayrıca yine bunu dedikten sonra
ElseIf Target.Column = "18"
demeye gerek yok. çünkü H sütunu dışında işlem yapılırsa koddan çık talimatını zaten vermişsiniz.


yine defalarca
ElseIf Target.Column = "8" And Target.Value = "" Then
Range("A" & Target.Row & ":K" & Target.Row).Interior.ColorIndex = xlNone

yazmaya gerek yok.

 

[wnkist]

Makroyu başka yerden alıp kendi sayfama uygulamaya çalıştığımdan böyle sorunlar oluyor. İlginiz için teşekkür ederim. Yardımınızı bekliyorum.

 

[mancubus]

pratik olarak veri girişi, takibi vs amaçlı excel sayfalarında "merged cells", gereksiz boş satır, vs kullanılmaması tavsiye edilir. gönülden katıldığım yaklaşımdır bu.

bundan ötürü kodları zorlayacak benzeri şeyleri kaldırarak denedim. yine dosyayı şişiren formatlar vb hiç tercih etmediğim şeylerdir. onları da.

siz o şekilde kullanmayı tercih ederseniz, kodlardaki sütun harflerini ona göre uyarlayınız.

ürün, depo, durum... için ilgili sütunlarda formül kullanılmış. formül hesaplamaları EVENT kodlarını tetiklemez (yani IF formülü kaynaklı değil, formül kaynaklıdır çalışmaması). bu nedenle formül değişimleri kendiliğinden kodları çalıştırmaz. o sütunlar için, hatta tüm mevcut verilerin formatları için 3 ayrı makro ekledim.

ayrıca....
maalesef...
formülün içine, belli koşullara göre 1, 2, 3 rakamlarının getirilmesini isterken, bu rakamları olduğu gibi değil de, "1", "2","3" şeklinde, tırnak içinde yazmışsınız.

uzun süre hatanın ne olduğunu bulmaya çalıştım. son anda farkettim rakamların tırnak içinde yazıldığını. ve bir hayli zaman kaybettim haliyle.

başka fonksiyonların içinde de kullanılacağını düşünerek gerek excel sayfalarında, gerekse kod içinde rakamları sadece rakam olarak yazalım. her zaman. metinleri ise tırnak içinde. kullanım yerine göre sayılarını artarak.




düzenlenmiş hali ile dosya ektedir.

module1'de ÜRETİM İŞ PROGRAMI sayfası için 2 ayrı kod var. verilerde_int_color_A_J makrosu Worksheet_Change makrosu yerine düşünülmüştür. 2sinden birini tercih ediniz.

verilerde_int_color_N_AE makrosu ise formül nedeni ile Worksheet_Change makrosu tetiklenmeyeceğinden, ayrıca, mesela tüm veri girişleri tamamlandıktan sonra, manuel veya bir butona atanarak çalıştırılmalıdır.

Module2'de 51.HAFTA sayfası için kod var. verilerde_int_color_A_I makrosu Worksheet_Change makrosu yerine düşünülmüştür. 2sinden birini tercih ediniz.

 

[wnkist]

Yaptığınız yardım, verdiğiniz bilgi ve çalışmalarınızdan dolayı teşekkür ederim.

Anladığım kadarıyla eğer formüllü bölüme istediğim gibi satır renklendirilmesi yapılamıyor. modul1'de vermiş olduğunuz verilerde_int_color_N_AE makrosuna buton atadım ancak çalıştıramadım. Zahmet olmasa biraz daha açıklayabilir misiniz?

Birde 51.haftada seri numarası bulunmadığında ya da seri numarasını sildiğimiz de satırın biçimlendirmesini de siliyor. Biçimlendirmeyi silmeden sadece hücre içindeki verileri silebilir miyiz?

Teşekkürler...

 

[mancubus]

2. soru için:

51.HAFTA'nın kod modülünden aşağıdaki satırları silmek yaterli.

    If IsEmpty(Target) Then 'veri silinirse rengi kaldırsın, koddan çıksın
        Range("A" & Target.Row & ":I" & Target.Row).Clear
        Exit Sub
    End If

 

[mancubus]

Modül1 ve 2'deki kodlar niye çalışmadı önümüzdeki hafta boş bir zamanımda bakabilirim gibi görünüyor.


aslında çalışmalarımı yavaşlattığı için benim kullanmaktan vaz geçtiğim ve bu nedenle aklıma gelmeyen WorkSheet_Calculate olayı N-AE sütunları formüllü bölüm içim kullanılabilir.

excel her hesaplama yaptığında kod kendiliğinden devreye girer:
1- Calculation seçeneği Automatic yapıldı ise hücre veri değişikliğinde excel calculation yapar.
2- Calculation seçeneği Manuel yapıldı ise hücre F9, Shift+F9, vs tuşlarına basıldığında excel calculation yapar.

böylece Modül1 ve 2'deki kodlara gerek kalmaz aslında.


ÜRETİM İŞ PROGRAMI'nın kod modülüne ekleyin.

Calculate olayının TARGET argümanı olmadığı için, tetiklendiğinde ilgili sütunlardaki tüm satırlar için yeniden tek tek işlem yapar.

hatta sütun no da dış döngü yapılarak kod kısaltılabilir.

Private Sub Worksheet_Calculate()

    Dim Durum, Renk2
    Dim i As Long, j As Long
    
    Durum = Array(1, 2, 3)
    Renk2 = Array(43, 33, 46)
    
    On Error Resume Next
    For j = 16 To 31 Step 3
        For i = 4 To Cells(Rows.Count, "A").End(xlUp).Row
        '16, 19, 22, 25, 28, 31 = P, S, V, Y, AB, AE sütunları
            With Cells(i, j)
                If .Value = "" Then
                    .Offset(, -2).Resize(, 3).Interior.ColorIndex = xlNone
                Else
                    .Offset(, -2).Resize(, 3).Interior.ColorIndex = Renk2(Application.Match(.Value, Durum, 0) - 1)
                End If
            End With
        Next i
    Next j

End Sub

 

[wnkist]

Kusura bakmayın birazz geç cevap verdim. Gönderdiğiniz örnek istediğim gibi çalışmak ancak kendi sayfama uyarlamak durumunda kaldığım için For j = 16 To 31 bunu For j = 18 To 33 olarak değiştirdim ancak çalışmadı. Çalışmama nedeni sizin örnekte makro kısmında peference to ATPV var bundan dolayı olabilir mi.

Teşekkür ederim.....

 

[mancubus]

8 no.lu mesajdaki ilk dosyaya uyarlanmış hali...