kaza takip programı

[ozgeCtn]

Arkadaşlar merhaba. Ben makro kullanmaya yeni başladım sitedeye de yeni üye oldum. Bir sorunum var yardımcı olursanız çok mutlu olurum.
Sub HatBul()


ActiveSheet.Range("H4").Select
If Range("G4").Value = "Dişli ve Isıl İşlem Müdürlüğü" Then
Application.Run "Dişli"
End If
If Range("G4").Value = "Gövde Üretim Müdürlüğü" Then
Application.Run "Gövde"
End If
If Range("G4").Value = "Motor Üretim Müdürlüğü" Then
Application.Run "Motor"
End If
If Range("G4").Value = "Montaj Üretim Müdürlüğü" Then
Application.Run "Montaj"
End If
If Range("G4").Value = "Üretim Takip Yöneticiliği" Then
Application.Run "Takip"


Şeklinde ilerleyen bir kaza takip formu hazırlıyorum. Fakat sadece 4.satıra uygulayabiliyorum bu formatı. diğer satırlara yeni bir giriş yaptığımda da aynı kodların çalışabilmesi için ne yapmam lazım. kaç tane giriş yapılacagı belli değil. gerçekleşen kaza sayılarına bağlı olarak değişecek.
Çok teşekkür ederim şimdiden

 

[Necdet]

Merhaba,

Örnek dosya eklerseniz çözüme daha çabuk ulaşırsınız.

Kodların tamamını görmeden şöyle bir düzeltme yaptım, deneyiniz.

Sub HatBul()
    
    Dim i   As Long
    
    For i = 4 To Cells(Rows.Count, "G").End(3).Row
    
        If Cells(i, "G") = "Dişli ve Isıl İşlem Müdürlüğü" Then
            Application.Run "Dişli"
        ElseIf Cells(i, "G") = "Gövde Üretim Müdürlüğü" Then
            Application.Run "Gövde"
        ElseIf Cells(i, "G") = "Motor Üretim Müdürlüğü" Then
            Application.Run "Motor"
        ElseIf Cells(i, "G") = "Montaj Üretim Müdürlüğü" Then
            Application.Run "Montaj"
        ElseIf Cells(i, "G") = "Üretim Takip Yöneticiliği" Then
            Application.Run "Takip"
        End If
    Next i
    
End Sub

 

[ozgeCtn]

Gizlilikten dolayı dosyanın tamamını paylaşamıyorum ama biraz daha açıklayıcı yazmaya çalısayım. bir kaza bildirimi geldiğinde makro ilk satır için doğru çalışıyor fakat 2. kaza bildirimi geldiğinde aynı işlemi yapamıyorum.
Yapmaya çalıstığım işlem çalışanın baglı olduğu müdürüğü yazdıktan sonra makronun çalışanın hattını otomatik olarak getirmesini sağlamak.



Bildirim № Müdürlük/Alan Hat Tezgah/İstasyon
1 Montaj Üretim Müdürlüğü G-2 2001--001
2 Üretim Takip Yöneticiliği
3
4
5
Bu sekilde gerçeklecek programama bildirim numarası 1 olan bildirim hariç çalıştıramıyorum makroyu. Yazdığınınz kodu da denedim ama işe yaramadı

 

[ozgeCtn]

Bir de elimde belirli bir miktar girilecek kaza yok kaza bildirimi geldikce girilecek programa.

 

[Necdet]

Sayın ozgeCtn,

sizden örnek dosya eklerseniz dedim. Gerçek dosyanızı değil.

Gerçek dosyanıza yakın 3-5 kayıtlık bir bilgi içeren dosya olabilir.

Bu şekilde ne yapmak istediğiniz pek anlaşılmıyor.

 

[ozgeCtn]

Ekte gönderdim dosyayı. İlginiz için teşekkürler.

 

[Necdet]

Merhaba,

Kodların mantığına dokunmadan düzenleme yaptım.

Bildirim adlı sayfanın kod bölümüne aşağıdaki kodları kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
 
If Intersect(Target, [F:G]) Is Nothing Or Target.Row < 4 Then Exit Sub
 
If Target.Column = 6 Then
HATBUL2 Target
Else
TEZGAHBUL2 Target
End If
 
End Sub

Hatbul2 ve Tezgahbul2 kodları parametre isteyen kodlar haline getirildi.

Sub HATBUL2(Hucre As Range)
 
    If Hucre.Value = "Dişli ve Isıl İşlem Müdürlüğü" Then
        Application.Run "DİŞLİ2"
    ElseIf Hucre.Value = "Gövde Üretim Müdürlüğü" Then
        Application.Run "Gövde"
    ElseIf Hucre.Value = "Motor Üretim Müdürlüğü" Then
        Application.Run "Motor"
    ElseIf Hucre.Value = "Montaj Üretim Müdürlüğü" Then
        Application.Run "Montaj"
    ElseIf Hucre.Value = "Üretim Takip Yöneticiliği" Then
        Application.Run "Takip"
    ElseIf Hucre.Value = "Bakım ve Teknik Hizmetler Müdürlüğü" Then
        Application.Run "Bakım"
    ElseIf Hucre.Value = "Diğer" Then
        Hucre.Offset(0, 1).Value = "Diğer"
    End If
End Sub

Sub TEZGAHBUL2(Hucre As Range)
    If Hucre.Value = "B-1" Then
        Application.Run "GövdeB1"
    ElseIf Hucre.Offset(0, -1).Value = "Bakım ve Teknik Hizmetler Müdürlüğü" Then
        Application.Run "Olmayan"
    ElseIf Hucre.Value = "B-2" Then
        Application.Run "GövdeB2"
    ElseIf Hucre.Value = "B-3" Then
        Application.Run "GövdeB3"
    ElseIf Hucre.Value = "B-4" Then
        Application.Run "GövdeB4"
    ElseIf Hucre.Value = "C01" Then
        Application.Run "GövdeC01"
    ElseIf Hucre.Value = "C02" Then
        Application.Run "GövdeC02"
    ElseIf Hucre.Value = "C03" Then
        Application.Run "GövdeC03"
    ElseIf Hucre.Value = "C04" Then
        Application.Run "GövdeC04"
    ElseIf Hucre.Value = "C05" Then
        Application.Run "GövdeC05"
    ElseIf Hucre.Value = "C06" Then
        Application.Run "GövdeC06"
    ElseIf Hucre.Value = "C07" Then
        Application.Run "GövdeC07"
    ElseIf Hucre.Value = "C08" Then
        Application.Run "GövdeC08"
    ElseIf Hucre.Value = "C09" Then
        Application.Run "GövdeC09"
    ElseIf Hucre.Value = "C10" Then
        Application.Run "GövdeC10"
    ElseIf Hucre.Value = "C11" Then
        Application.Run "GövdeC11"
    ElseIf Hucre.Value = "C12" Then
        Application.Run "GövdeC12"
    ElseIf Hucre.Value = "C13" Then
        Application.Run "GövdeC13"
    ElseIf Hucre.Value = "Krank" Then
        Application.Run "MotorKrank"
    ElseIf Hucre.Value = "Montaj" Then
        Application.Run "MotorMontaj"
    ElseIf Hucre.Value = "Motor Bloğu" Then
        Application.Run "MotorBlok"
    ElseIf Hucre.Value = "Silindir Kafa" Then
        Application.Run "MotorSilindir"
    ElseIf Hucre.Value = "Bremze" Then
        Application.Run "MotorBremze"
    ElseIf Hucre.Value = "G1 Gövde Birleştirme" Then
        Application.Run "MontajG1Birleştirme"
    ElseIf Hucre.Value = "G-1" Then
        Application.Run "MontajG1"
    ElseIf Hucre.Value = "G-2" Then
        Application.Run "MontajG2"
    ElseIf Hucre.Value = "Şanzıman" Then
        Application.Run "MontajŞanzıman"
    ElseIf Hucre.Value = "Arızi Bakım Yöneticiliği" Then
        Application.Run "Olmayan"
    End If
End Sub

Kodları deneyiniz.