Makroda hata uyarısı

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
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,700
Excel Vers. ve Dili
Excel 2019 Türkçe
İki kodu birleştirmelisiniz, bu şekilde kullanamazsınız.
 
O

ormann

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
iki kodu birleştirdiğim zaman makrolarçalışmıyohocam
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,700
Excel Vers. ve Dili
Excel 2019 Türkçe
Doğru birleştiremiyorsunuz yada çakışan yerler vardır demektir.
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,700
Excel Vers. ve Dili
Excel 2019 Türkçe
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
 
O

ormann

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
sayın hocam olmuş fakat veri çağırdığım zaman "LÜTFEN DAVA TAKİP NOYU GİRİNİZ" uyarısı gelmemesi gerekiyo
 
O

ormann

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
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
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,700
Excel Vers. ve Dili
Excel 2019 Türkçe
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.
 
H

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,700
Excel Vers. ve Dili
Excel 2019 Türkçe
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
 
O

ormann

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
hocam teşekür ederim .sizide zahmete soktum.benim dediğim şekilde olsaydı iyi olurdu.ne yapalım sağlık olsun
 
A

AS3434

Özel Üye
Katılım
13 Ocak 2005
Mesajlar
1,820
Excel Vers. ve Dili
M.Office/Excel 2007 Türkçe
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
 
O

ormann

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
sayın hocam uyguladım fakat veri çağırdığım zaman gene dava takip noyu girin diyor
 
A

AS3434

Özel Üye
Katılım
13 Ocak 2005
Mesajlar
1,820
Excel Vers. ve Dili
M.Office/Excel 2007 Türkçe
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
 
O

ormann

Katılım
9 Ekim 2009
Mesajlar
1,626
Excel Vers. ve Dili
türkçe
2003
sayın hocam veri çağırma aktif olmadı.verileri çağıramadım
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst