• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Çoklu Kod Kullanımında Hata İletisi alıyorum

A

AloneX

Katılım
13 Eylül 2008
Mesajlar
10
Excel Vers. ve Dili
yok
Merhaba Arkadaşlar;

Öncelikle sorunum hazırlamış olduğum Excell dosyasında VB kısmında aşağıda yazdığım kodları aynı anda kullanmaya çalışnca hata iletisi alıyorum ama hepsini tek tek denedğimde çalışıyor.Bu kodları aynı anda nasıl kullanabilirim.Kdolar hakkında yeniyim... çalışam yaptığım dosya Ek'te mevcuttur.
Yardımlarınız için teşekürler...

Kod: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$1" Or Target >= 0 And Target <= 100 Then 'HAT1'
[B2,C2,D2,E2].Select
End If
If Target.Address = "$E$2" Then
[B3,C3,D3,E3].Select
End If
If Target.Address = "$E$3" Then
[B4,C4,D4,E4].Select
End If
If Target.Address = "$E$4" Then
[B5,C5,D5,E5].Select
End If
If Target.Address = "$E$5" Then
[B6,C6,D6,E6].Select
End If
If Target.Address = "$E$6" Then
[B7,C7,D7,E7].Select
End If
End Sub
If Target.Address = "$E$10" Or Target >= 0 And Target <= 100 Then 'HAT2'
[B10,C10,D10,E10].Select
End If
If Target.Address = "$E$11" Then
[B11,C11,D11,E11].Select
End If
If Target.Address = "$E$12" Then
[B12,C12,D12,E12].Select
End If
If Target.Address = "$E$13" Then
[B13,C13,D13,E13].Select
End If
If Target.Address = "$E$14" Then
[B14,C14,D14,E14].Select
End If
If Target.Address = "$E$15" Then
[B15,C15,D15,E15].Select
End If
End Sub
If Target.Address = "$E$18" Or Target >= 0 And Target <= 100 Then 'HAT3'
[B18,C18,D18,E18].Select
End If
If Target.Address = "$E$19" Then
[B19,C19,D19,E19].Select
End If
If Target.Address = "$E$20" Then
[B20,C20,D20,E20].Select
End If
If Target.Address = "$E$21" Then
[B21,C21,D21,E21].Select
End If
If Target.Address = "$E$22" Then
[B22,C22,D22,E22].Select
End If
If Target.Address = "$E$23" Then
[B23,C23,D23,E23].Select
End If
End Sub
If Target.Address = "$E$26" Or Target >= 0 And Target <= 100 Then 'HAT4'
[B26,C26,D26,E26].Select
End If
If Target.Address = "$E$27" Then
[B27,C27,D27,E27].Select
End If
If Target.Address = "$E$28" Then
[B28,C28,D28,E28].Select
End If
If Target.Address = "$E$29" Then
[B29,C29,D29,E29].Select
End If
If Target.Address = "$E$30" Then
[B30,C30,D30,E30].Select
End If
If Target.Address = "$E$31" Then
[B31,C31,D31,E31].Select
End If
End Sub
If Target.Address = "$E$26" Or Target >= 0 And Target <= 100 Then 'HAT4'
[B26,C26,D26,E26].Select
End If
If Target.Address = "$E$27" Then
[B27,C27,D27,E27].Select
End If
If Target.Address = "$E$28" Then
[B28,C28,D28,E28].Select
End If
If Target.Address = "$E$29" Then
[B29,C29,D29,E29].Select
End If
If Target.Address = "$E$30" Then
[B30,C30,D30,E30].Select
End If
If Target.Address = "$E$31" Then
[B31,C31,D31,E31].Select
End If
End Sub
If Target.Address = "$P$1" Or Target >= 0 And Target <= 100 Then 'HAT5'
[M2,N2,O2,P2].Select
End If
If Target.Address = "$P$2" Then
[M2,N2,O2,P2].Select
End If
If Target.Address = "$P$3" Then
[M3,N3,O3,P3].Select
End If
If Target.Address = "$P$4" Then
[M4,N4,O4,P4].Select
End If
If Target.Address = "$P$5" Then
[M5,N5,O5,P5].Select
End If
If Target.Address = "$P$6" Then
[M6,N6,O6,P6].Select
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'HÜCRELERE VERİ GİRİLMEDİĞİ ZAMAN UYARI'
If Intersect(Target, Range("C2:C7,D2:D7,E2:E7,C10:C15,D10:D15,E10:E15,C18:C23,D18:D23,E18:E23,C26:C31,D26:D31,E26:E31,N2:N7,O2:O7,P2:P7,N10:N15,O10:O15,P10:P15,N18:N23,O18:O23,P18:P23,N26:N31,O26:O31,P26:P31")) Is Nothing Then Exit Sub
If row <> 0 Then
    If Cells(row, col) = "" And Target.row <> row Then
        MsgBox ("SAAT TARİH MİKTARI BOŞ GEÇEMEZSİN")
        Cells(row, col).Select
        Exit Sub
    End If
End If
If Target.row <> row Then
    row = Target.row
    col = Target.Column
End If
End Sub
 Sub Formul_bul_koru() 'TABLODA FORMULLÜ HÜCRELERİ BULUP KORUMA ALTINA ALIR'
    Cells.Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Call ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

If Intersect(Target, [B2]) Is Nothing Then Exit Sub 'B2 HÜCRESİNE VERİ GİRİLİNCE 20 SIRA ATLAYARAK V2 HÜCRESİNE TARİH ATAR'
If Target.Column = 5 Then
    Atla = 20
Else
    Atla = 20
End If
If Target > "" Then
    Target.Offset(0, Atla) = Now
Else
    Target.Offset(0, Atla) = ""
End If
End Sub
 

Ekli dosyalar

Worksheet_Change olay kodunda bir çok END SUB var.
birleştirme yapılırken silinmemiş.
temizlemek lazım.
tekrar hata verirse bakalım.
 
END SUB ifadelerini kaldırdım genede hata alıyorum.Ya çalışmıyor yada hiç işlem yapmıyor.Birde siz baksanız.
 
AloneX' Alıntı:
END SUB ifadelerini kaldırdım genede hata alıyorum.Ya çalışmıyor yada hiç işlem yapmıyor.Birde siz baksanız.
Genişletmek için tıkla ...
Sn. AloneX,
Yaptığınız kodlamayı ve hataları gözden geçirince makro konusunda henüz oldukça yeni olduğunuzu anlıyorum. Kodlarınızın içinden çıkmak zor. Benim önerim koddaki hataları bulmaya çalışmak yerine ne yapmak istediğinizi anlatmanızdır. Böylece sorunuza daha çabuk cevap alır ve daha pratik çözüm önerileri alabilirsiniz.
 
1. oluşturulan macroda B2 hücresine değer girildiğinde enter tuşuna basıldığında alt satıra değil C2 hücresine C2 değer girilince D2 hücresine ,D2hücresine deger girilince E2 hücresine geçiş yapması gerekiyor.E2'değer girildiğinde enter'e basınca b3 hücresine geçiş yapıyor.1.macronun mantığı bu.
2-Macroda ise veri girişi yapıcak personelin hücrelere veri girişi yapmadan gecmesini engellemek.
Örnek olarak B2 hücresine deger girdiği zaman C2,D2,E2 hücrelerinede deger girmesini saglamak.
Basitce 2 makronun mantığı bu.
Benim sorunum bu makrolara tek başına kullanıldığında normal bir sekilde çalışıyor , ama diğer makroyu da yazdığım zaman çalışmıyor.yada birinci yazılan makroda kodları uzatırken ben mi hata yapıyorum çıkamadım işin içinden.
yardımlarınız için teşekürler....
 
arkadaşım dosyanı eklersen daha fazla fikir verir.
sırasıyla B-C-D-E stunlarına ve peşinde alt satıra gitsin demişsin ama eklediğin kodda M, P vs sütunlar da var.

sadece bu kısmı için aşağıdaki yeterli olur.

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column = 1 Or Target.Column > 5 Then Exit Sub

    If Target.Column = 5 Then
        Target.Offset(1, -3).Select
    Else
        Target.Offset(, 1).Select
    End If
   
End Sub
 
Dosya Ek'te mevcut zaten dosyayı indirdiyseniz ne demek istediğim anlamış olursunuz.
 
bazan baktığım halde göremiyorum demek ki.
çok feci mahcup oldum.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst