• DİKKAT

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

Makroda hata uyarısı

  • Konbuyu başlatan Konbuyu başlatan ormann
  • Başlangıç tarihi Başlangıç tarihi
O

ormann

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
ARKADAŞLAR AŞAĞIDA İKİ AYRI (Private Sub worksheet _Change (ByVal Target As Range) makrosunu aynı sayfaya girdiğimde hata veriyo çok uğramama ramen bir türlü çözemedim.yardımlarınızı bekliyorum.




Private Sub Worksheet_Change(ByVal Target As Range)
Dim s, Dosya_Yolu As String
Dosya_Yolu = ThisWorkbook.Path & "\"
Dim yer As Worksheet
Dim bul As Range
Dim sat As Integer
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Intersect(Target, Range("C3,D3,E3,F3,G3,H3")) Is Nothing Then Exit Sub
Set yer = Sheets("SUÇ KAYDI")
Set bul = yer.Cells.Find(Target, , xlValues, xlWhole)
If bul Is Nothing Then
ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "KAYIT BULUNAMADI.wav"")")
Exit Sub
Else
sat = bul.Row
End If
yer.Range("A" & sat & ":L" & sat).Copy
Range("D5").PasteSpecial xlPasteValues, , , True
yer.Range("O" & sat & ":S" & sat).Copy
Range("D17").PasteSpecial xlPasteValues, , , True
yer.Range("V" & sat & ":Y" & sat).Copy
Range("D22").PasteSpecial xlPasteValues, , , True
yer.Range("AM" & sat & ":AP" & sat).Copy
Range("D25").PasteSpecial xlPasteValues, , , True
Range("F17").Value = yer.Range("AP" & sat & ":AP" & sat).Value
yer.Range("AR" & sat & ":AR" & sat).Copy
Range("D31").PasteSpecial xlPasteValues, , , True
yer.Range("BW" & sat & ":BW" & sat).Copy
Range("D32").PasteSpecial xlPasteValues, , , True
yer.Range("AS" & sat & ":Bj" & sat).Copy
Range("D38").PasteSpecial xlPasteValues, , , True
yer.Range("BY" & sat & ":BY" & sat).Copy
Range("D34").PasteSpecial xlPasteValues, , , True

Application.CutCopyMode = False
Range("D5").Activate
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D10]) Is Nothing Then Exit Sub
If [d5].Value > 0 Then Exit Sub
x = InputBox("LÜTFEN DAVA TAKİP NOYU GİRİNİZ ?", "DAVA TAKİP NO")
[d5].Value = x
End Sub
 
İki kodu birleştirmelisiniz, bu şekilde kullanamazsınız.
 
iki kodu birleştirdiğim zaman makrolarçalışmıyohocam
 
Doğru birleştiremiyorsunuz yada çakışan yerler vardır demektir.
 
Dosyanızı incelemedim ama iki kodu birleştirdim, bu şekilde bir deneyin.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s, Dosya_Yolu As String
Dosya_Yolu = ThisWorkbook.Path & "\"
Dim yer As Worksheet
Dim bul As Range
Dim sat As Integer
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
[COLOR=BLUE]If Intersect(Target, Range("C3,D3,E3,F3,G3,H3,[COLOR=RED][B]D10[/B][/COLOR]")) Is Nothing Then Exit Sub
If [d5].Value > 0 Then Exit Sub
x = InputBox("LÜTFEN DAVA TAKİP NOYU GİRİNİZ ?", "DAVA TAKİP NO")
[d5].Value = x[/COLOR]

Set yer = Sheets("SUÇ KAYDI")
Set bul = yer.Cells.Find(Target, , xlValues, xlWhole)
If bul Is Nothing Then
ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "KAYIT BULUNAMADI.wav"")")
Exit Sub
Else
sat = bul.Row
End If
yer.Range("A" & sat & ":L" & sat).Copy
Range("D5").PasteSpecial xlPasteValues, , , True
yer.Range("O" & sat & ":S" & sat).Copy
Range("D17").PasteSpecial xlPasteValues, , , True
yer.Range("V" & sat & ":Y" & sat).Copy
Range("D22").PasteSpecial xlPasteValues, , , True
yer.Range("AM" & sat & ":AP" & sat).Copy
Range("D25").PasteSpecial xlPasteValues, , , True
Range("F17").Value = yer.Range("AP" & sat & ":AP" & sat).Value
yer.Range("AR" & sat & ":AR" & sat).Copy
Range("D31").PasteSpecial xlPasteValues, , , True
yer.Range("BW" & sat & ":BW" & sat).Copy
Range("D32").PasteSpecial xlPasteValues, , , True
yer.Range("AS" & sat & ":Bj" & sat).Copy
Range("D38").PasteSpecial xlPasteValues, , , True
yer.Range("BY" & sat & ":BY" & sat).Copy
Range("D34").PasteSpecial xlPasteValues, , , True

Application.CutCopyMode = False
Range("D5").Activate
End Sub
 
sayın hocam olmuş fakat veri çağırdığım zaman "LÜTFEN DAVA TAKİP NOYU GİRİNİZ" uyarısı gelmemesi gerekiyo
 
birde sayın hocam d5 hücresinde veri var iken başka bir veri çağırdığımda gelmiyo .ancak d5 hücresini silersem kayıtları çağırabiliyorum
 
Bence bir yerde mantık hatası var. Kodda birbiri ile çelişen satırlar olabilir yada mesaj veren satırın kod içindeki yerini değiştirmek gerekebilir. Bunları dikkate alarak bu kısıtları tekrar gözden geçirmelisiniz.
 
Kodlarınızın içinde boğuldum, çok kapsamlı bir çalışma. Size önerim, aşağıdaki kodu, bir tuşa bağlamanız. Bu şekilde kontrol etmeniz daha kolay olacaktır hem de diğer kodlar ile çakışmayacaktır.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D10]) Is Nothing Then Exit Sub
If [d5].Value > 0 Then Exit Sub
x = InputBox("LÜTFEN DAVA TAKİP NOYU GİRİNİZ ?", "DAVA TAKİP NO")
[d5].Value = x
End Sub
 
hocam teşekür ederim .sizide zahmete soktum.benim dediğim şekilde olsaydı iyi olurdu.ne yapalım sağlık olsun
 
ormann' Alıntı:
birde sayın hocam d5 hücresinde veri var iken başka bir veri çağırdığımda gelmiyo .ancak d5 hücresini silersem kayıtları çağırabiliyorum
Genişletmek için tıkla ...

Sayın ormann

Size kodları yazarken D5 hücresine kendiniz veri girmek isterseniz diye seçenek sunmuştum, ancak her veri girişinde sorması için kodları göndermiştim. kodlardaki kırmızı yeri silin.... Zaten o satırın önünde kesme işareti vardı....Yani kodlar pasif durumdaydı..

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D10]) Is Nothing Then Exit Sub
[COLOR=red]If [d5].Value > 0 Then Exit Sub[/COLOR]
x = InputBox("LÜTFEN DAVA TAKİP NOYU GİRİNİZ ?", "DAVA TAKİP NO")
[d5].Value = x
End Sub
 
sayın hocam uyguladım fakat veri çağırdığım zaman gene dava takip noyu girin diyor
 
Sayın ormann

Size yazdıklarım kısmi bölümler siz bütünleştirirsiniz diye düşünmüştüm.... İki makroyu Sayın Hamitcan 'ın yazdığı şekilde birleştirin ve şöyle düzeltin...

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s, Dosya_Yolu As String
Dosya_Yolu = ThisWorkbook.Path & "\"
Dim yer As Worksheet
Dim bul As Range
Dim sat As Integer
[COLOR=#ff0000]Application.EnableEvents = False[/COLOR]
 
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Intersect(Target, Range("C3,D3,E3,F3,G3,H3,D10")) Is Nothing Then Exit Sub
 
[COLOR=blue]x = InputBox("LÜTFEN DAVA TAKİP NOYU GİRİNİZ ?", "DAVA TAKİP NO")[/COLOR]
[COLOR=blue][d5].Value = x[/COLOR]
[COLOR=blue] [/COLOR]
[COLOR=#ff0000]Application.EnableEvents = True[/COLOR]
Set yer = Sheets("SUÇ KAYDI")
Set bul = yer.Cells.Find(Target, , xlValues, xlWhole)
If bul Is Nothing Then
ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "KAYIT BULUNAMADI.wav"")")
Exit Sub
Else
sat = bul.Row
End If
yer.Range("A" & sat & ":L" & sat).Copy
Range("D5").PasteSpecial xlPasteValues, , , True
yer.Range("O" & sat & ":S" & sat).Copy
Range("D17").PasteSpecial xlPasteValues, , , True
yer.Range("V" & sat & ":Y" & sat).Copy
Range("D22").PasteSpecial xlPasteValues, , , True
yer.Range("AM" & sat & ":AP" & sat).Copy
Range("D25").PasteSpecial xlPasteValues, , , True
Range("F17").Value = yer.Range("AP" & sat & ":AP" & sat).Value
yer.Range("AR" & sat & ":AR" & sat).Copy
Range("D31").PasteSpecial xlPasteValues, , , True
yer.Range("BW" & sat & ":BW" & sat).Copy
Range("D32").PasteSpecial xlPasteValues, , , True
yer.Range("AS" & sat & ":Bj" & sat).Copy
Range("D38").PasteSpecial xlPasteValues, , , True
yer.Range("BY" & sat & ":BY" & sat).Copy
Range("D34").PasteSpecial xlPasteValues, , , True
 
Application.CutCopyMode = False
Range("D5").Activate
End Sub
 
sayın hocam veri çağırma aktif olmadı.verileri çağıramadım
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst